summaryrefslogtreecommitdiff
path: root/modules/language
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-05-06 20:07:42 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-05-06 20:07:42 +0200
commit1753734c420edd4a5a641ad8e9c7250534dff136 (patch)
tree334ac95b3bbb7f52ef3d324ce02733506ae7a67c /modules/language
parent3d529f7540ca954131802a832be6811f2815ed0e (diff)
further improvements
Diffstat (limited to 'modules/language')
-rw-r--r--modules/language/python/compile.scm34
-rw-r--r--modules/language/python/for.scm22
-rw-r--r--modules/language/python/list.scm7
-rw-r--r--modules/language/python/module/collections.scm8
-rw-r--r--modules/language/python/module/collections/abc.scm2
-rw-r--r--modules/language/python/module/enum.py2
-rw-r--r--modules/language/python/module/python.scm4
-rw-r--r--modules/language/python/module/types.scm2
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__))