diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/compile.scm | 34 | ||||
-rw-r--r-- | modules/language/python/for.scm | 22 | ||||
-rw-r--r-- | modules/language/python/list.scm | 7 | ||||
-rw-r--r-- | modules/language/python/module/collections.scm | 8 | ||||
-rw-r--r-- | modules/language/python/module/collections/abc.scm | 2 | ||||
-rw-r--r-- | modules/language/python/module/enum.py | 2 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 4 | ||||
-rw-r--r-- | modules/language/python/module/types.scm | 2 | ||||
-rw-r--r-- | modules/oop/pf-objects.scm | 42 |
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) |