further improvements

9 files changed, 74 insertions, 49 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 00443a9..5d7796b 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -1684,6 +1684,24 @@
 
 (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)
@@ -1754,7 +1772,7 @@
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (next inv))
-                     (lambda (xx ...)
+                     (clambda (xx ...)
                        (set! x xx) ... 
                        (with-sp ((break    (values))
                                  (continue (values)))
@@ -1770,7 +1788,7 @@
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (values (next inv) ...))
-                     (lambda (xx ...)
+                     (clambda (xx ...)
                        (set! x xx) ...
                        (with-sp ((break    (values))
                                  (continue (values)))
@@ -1787,7 +1805,7 @@
                   (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))
@@ -1805,7 +1823,7 @@
                   (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))
@@ -1841,7 +1859,7 @@
                        (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))
@@ -1856,7 +1874,7 @@
                        (lambda ()
                          (let lp ()
                            (call-with-values (lambda () (next inv))
-                             (lambda (xx ...)
+                             (clambda (xx ...)
                                (set! x xx) ...
                                (with-sp ((break     (break-ret))
                                          (continue  (values)))
@@ -1875,7 +1893,7 @@
                      (lambda ()
                        (let lp ()
                          (call-with-values (lambda () get)
-                           (lambda (xx ...)
+                           (clambda (xx ...)
                              (set! x xx) ...
                              (let/ec continue-ret
                                (with-sp ((break     (break-ret))
@@ -1890,7 +1908,7 @@
                      (lambda ()
                        (let lp ()
                          (call-with-values (lambda () get)
-                           (lambda (xx ...)
+                           (clambda (xx ...)
                              (set! x xx) ...
                              (with-sp ((break     (break-ret))
                                        (continue  (values)))
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index c618828..76c9fa8 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -80,12 +80,12 @@
                                   (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)
@@ -145,8 +145,14 @@
   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>))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 91b66b4..e488e45 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -568,7 +568,12 @@
 
 (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>)))
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index 04f7ab6..7c2b89f 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -116,7 +116,7 @@
 	       (= 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)))
@@ -125,8 +125,8 @@
 	   (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!))
@@ -145,7 +145,7 @@
 	  (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)))))))))))
 
diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm
index 4d442d3..37815d8 100644
--- a/modules/language/python/module/collections/abc.scm
+++ b/modules/language/python/module/collections/abc.scm
@@ -504,7 +504,7 @@
   (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)
diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py
index 723fab7..e657af3 100644
--- a/modules/language/python/module/enum.py
+++ b/modules/language/python/module/enum.py
@@ -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,
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 7b01c93..3601c2f 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -126,7 +126,9 @@
        (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)
diff --git a/modules/language/python/module/types.scm b/modules/language/python/module/types.scm
index 840b901..a148426 100644
--- a/modules/language/python/module/types.scm
+++ b/modules/language/python/module/types.scm
@@ -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__))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 361e6ee..768cb6e 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -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)