diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-05-06 20:07:42 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-05-06 20:07:42 +0200 |
commit | 1753734c420edd4a5a641ad8e9c7250534dff136 (patch) | |
tree | 334ac95b3bbb7f52ef3d324ce02733506ae7a67c /modules/language | |
parent | 3d529f7540ca954131802a832be6811f2815ed0e (diff) |
further improvements
Diffstat (limited to 'modules/language')
-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 |
8 files changed, 56 insertions, 25 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__)) |