further improvements
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 6 May 2018 18:07:42 +0000 (20:07 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 6 May 2018 18:07:42 +0000 (20:07 +0200)
modules/language/python/compile.scm
modules/language/python/for.scm
modules/language/python/list.scm
modules/language/python/module/collections.scm
modules/language/python/module/collections/abc.scm
modules/language/python/module/enum.py
modules/language/python/module/python.scm
modules/language/python/module/types.scm
modules/oop/pf-objects.scm

index 00443a9ff2bed1fc136d698ebb002887611e0293..5d7796bef31f659be6f17b25f91582552469d14f 100644 (file)
 
 (define (gentemp stx) (datum->syntax stx (gensym "x")))
 
+(define-syntax clambda
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (x ...) code ...)
+       (with-syntax ((n (length #'(x ...))))
+         #'(let ((f (lambda (x ... . u) code ...)))
+             (if (> n 1)                
+                 (case-lambda
+                   ((c)
+                    (if (pair? c)
+                        (let ((cc (cdr c)))
+                          (if (pair? cc)
+                              (apply f c)
+                              (f c cc)))
+                        (py-apply f (* c))))
+                   (q (apply f q)))
+                 f)))))))
+
 (define-syntax cfor
   (syntax-rules ()
     ((_ (x) (a) code #f #f)
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (next inv))
-                     (lambda (xx ...)
+                     (clambda (xx ...)
                        (set! x xx) ... 
                        (with-sp ((break    (values))
                                  (continue (values)))
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (values (next inv) ...))
-                     (lambda (xx ...)
+                     (clambda (xx ...)
                        (set! x xx) ...
                        (with-sp ((break    (values))
                                  (continue (values)))
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (next inv))
-                        (lambda (xx ...)
+                        (clambda (xx ...)
                           (set! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
-                        (lambda (xx ...)
+                        (clambda (xx ...)
                           (set! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                        (lambda ()
                          (let lp ()
                            (call-with-values (lambda () (next inv))
-                             (lambda (xx ...)
+                             (clambda (xx ...)
                                (set! x xx) ...
                                (let/ec continue-ret
                                  (with-sp ((break     (break-ret))
                        (lambda ()
                          (let lp ()
                            (call-with-values (lambda () (next inv))
-                             (lambda (xx ...)
+                             (clambda (xx ...)
                                (set! x xx) ...
                                (with-sp ((break     (break-ret))
                                          (continue  (values)))
                      (lambda ()
                        (let lp ()
                          (call-with-values (lambda () get)
-                           (lambda (xx ...)
+                           (clambda (xx ...)
                              (set! x xx) ...
                              (let/ec continue-ret
                                (with-sp ((break     (break-ret))
                      (lambda ()
                        (let lp ()
                          (call-with-values (lambda () get)
-                           (lambda (xx ...)
+                           (clambda (xx ...)
                              (set! x xx) ...
                              (with-sp ((break     (break-ret))
                                        (continue  (values)))
index c618828be6d15838d9ecb742f3bd6de0dfdd62a7..76c9fa86e385a7d334224123395d49466bf49b4a 100644 (file)
                                   (set! x1 x2) ...)))
                            (if (> N 1)
                                (case-lambda
-                               ((q)
-                                (if (pair? q)
-                                    (if (pair? (cdr q))
-                                        (apply f q)
-                                        (apply f (car q) (cdr q)))
-                                    (py-apply f (* q))))
+                                 ((q)
+                                  (if (pair? q)
+                                      (if (pair? (cdr q))
+                                          (apply f q)
+                                          (apply f (car q) (cdr q)))
+                                      (py-apply f (* q))))
                                  (q
                                   (apply f q)))
                                (lambda (x2 ... . ll)
   o)
 
 (define-method (wrap-in (o <p>))
-  (aif it (ref o '__iter__)
-       (it)
+  (aif it (pk 2 (ref (pk 1 o) '__iter__))
+       (let ((x (it)))
+         (pk 3  x)
+         (cond
+          ((pair? x)
+           (wrap-in x))
+          (else
+           x)))
        (next-method)))
 
 (define-method (next (l <p>))
index 91b66b4cb6c7f2c455130478327280363ccc1713..e488e45e19dc8da5638a74ea0ccf70a8eb06e9fa 100644 (file)
 
 (define-method (wrap-in (o <p>))
   (aif it (ref o '__iter__)
-       (it)
+       (let ((x (it)))
+         (cond
+          ((pair? x)
+           (wrap-in x))
+          (else
+           x)))
        (let ((a (ref o '__getitem__)))
          (if a
              (let ((ret (make <py-seq-iter>)))
index 04f7ab68e6129efaae0d16ad58c0b320e6ecd282..7c2b89f8ff5ff5f30be7c6c02610f9fda30f4838 100644 (file)
               (= dict_setitem dict-set!)
               (= proxy        #f)
               (= link         link))    
-     (if (in key self)
+     (if (not (in key self))
         (let* ((link (link))
                (root (ref self '__root))
                (last (get-last root)))
           (set-next! link root)
           (set-key!  link key)
            (set-next! last link)
-           (set-prev! root link)
-          (dict-set! self key value)))))
+           (set-prev! root link)))
+     (dict-set! self key value)))
 
   (define __delitem__
     (lam (self key (= dict_delitem dict-del!))
          (let ((root (ref self '__root)))
            (let lp ((curr (get-next root)))
              (if (not (eq? curr root))
-                 (let ((key (get-key curr)))
+                 (let ((key (get-key curr)))               
                    (yield key (pylist-ref self key))
                    (lp (get-next curr)))))))))))
 
index 4d442d3d1b45f7c1ddf840de4c3bef3b2d479c74..37815d83fa9b4c379981e6611752fe9f874f2d4d 100644 (file)
   (define __len__
     (lambda (self) (len (ref self '_mapping)))))
                    
-(define-python-class ItemsView   (MappingView Set)
+(define-python-class ItemsView (MappingView Set)
   ;; Mixins
   (define __contains__
     (lambda (self x)
index 723fab7e0951be8d672b796ddfa7e7bf9f42e72f..e657af35a1252ca5257333e5528b4c2b32aa46f0 100644 (file)
@@ -129,7 +129,7 @@ class EnumMeta(type):
         # cannot be mixed with other types (int, float, etc.) if it has an
         # inherited __new__ unless a new __new__ is defined (or the resulting
         # class will fail).
-
+        pk('new',metacls,cls)
         member_type, first_enum = metacls._get_mixins_(bases)
 
         new, save_new, use_args = metacls._find_new_(classdict, member_type,
index 7b01c93df7ec56692d480923e015a3f28289abaf..3601c2f07c5222cd7fb21a610913a8c9df4d3e8b 100644 (file)
        (it cls sub)
        (if (eq? sub cls)
           #t
-          (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
+          (if (memq cls (ref sub '__mro__))
+               #t
+               #f))))
 
 (define-method (isinstance x y)
   (if (null? y)
index 840b901928bde1bf2117b7ed13cf031d8e7d3029..a148426a72b1561fe82a680284d145eab97254bd 100644 (file)
@@ -42,7 +42,7 @@ Define names for built-in types that aren't directly accessible as a builtin.
               (bool (getattr fget '__isabstractmethod__' #f)))))
 
   (define __get__
-    (lam (self instance (= ownerclass None))
+    (lam (self instance (= ownerclass None))         
          (cond
           ((eq? instance None)
            (if (bool (ref self '__isabstractmethod__))
index 361e6eecd69f841333077a405f83f0bdae06244e..768cb6edfd4402db14f2ea3f3fdabe79b1c92246 100644 (file)
@@ -903,27 +903,21 @@ explicitly tell it to not update etc.
                          (let* ((p   (car cparents))
                                 (m   (rawref p '__class__))
                                 (mro (reverse (ref m '__mro__ '()))))
-                           (let lp ((l   (cdr cparents))
-                                    (max mro)
-                                    (min mro))
-                             (if (pair? l)
-                                 (let* ((p    (car l))
-                                        (meta (rawref p '__class__))
-                                        (mro  (ref meta '__mro__ '())))
-                                   (let lp2 ((max max) (mr (reverse mro)))
-                                     (if (and (pair? max) (pair? mr))
-                                         (if (eq? (car max) (car mr))
-                                             (lp2 (cdr max) (cdr mr))
-                                             (error
-                                              "need a common lead for meta"))
-                                         (if (pair? max)
-                                             (if (< (length mro) (length min))
-                                                 (lp (cdr l) max mro)
-                                                 (lp (cdr l) max min))
-                                             (lp (cdr l) mro min)))))
-                                 (if (null? min)
-                                      type
-                                      (car (reverse min)))))))))
+                            (let lp ((l (cdr cparents)) (m m) (mro mro))
+                              (match l
+                                ((pp . l)
+                                 (aif mm (rawref pp '__class__)
+                                      (aif mmro (rawref mm '__mro__)
+                                           (cond
+                                            ((memq m mmro)
+                                             (lp l mm mmro))
+                                            ((memq mm mro)
+                                             (lp l m  mro))
+                                            (error "TypeError for meta"))
+                                           (lp l m mro))
+                                      (lp l m mro)))
+                                (() m)))))))
+                                
     (define (unique l)
       (define t (make-hash-table))
       (let lp ((l l))
@@ -1446,8 +1440,8 @@ explicitly tell it to not update etc.
     (define key (if (string? key-) (string->symbol key-) key-))
     (aif class (find-in-class-raw self '__class__ #f)
          (kif it1 (ficap class key fail)
-              (aif dd1 (rawref it1 '__get__)
-                   (if (rawref it1 '__set__)
+              (aif dd1 (ref it1 '__get__)
+                   (if (ref it1 '__set__)
                        (dd1 self class)
                        (kif it2 (ficap self key fail)
                             it2
@@ -1462,7 +1456,7 @@ explicitly tell it to not update etc.
                                    (lambda ()
                                      (it self (symbol->string key)))
                                    (lambda x fail))
-                             (aif dd1 (rawref it1 '__get__)
+                             (aif dd1 (ref it1 '__get__)
                                   (dd1 self class)
                                   it1)
                              fail)