summaryrefslogtreecommitdiff
path: root/modules/language/python/compile.scm
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python/compile.scm')
-rw-r--r--modules/language/python/compile.scm131
1 files changed, 115 insertions, 16 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 34cc4df..dc608a4 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -3,6 +3,7 @@
#:use-module (ice-9 control)
#:use-module (oop pf-objects)
#:use-module (oop goops)
+ #:use-module (language python dict)
#:use-module (language python exceptions)
#:use-module (language python yield)
#:use-module (language python for)
@@ -56,16 +57,18 @@
x)
-(define-inlinable (C x) `(@@ (language python compile) ,x))
-(define-inlinable (Y x) `(@@ (language python yield) ,x))
-(define-inlinable (T x) `(@@ (language python try) ,x))
-(define-inlinable (F x) `(@@ (language python for) ,x))
-(define-inlinable (L x) `(@@ (language python list) ,x))
-(define-inlinable (A x) `(@@ (language python array) ,x))
-(define-inlinable (S x) `(@@ (language python string) ,x))
-(define-inlinable (D x) `(@@ (language python def) ,x))
-(define-inlinable (O x) `(@@ (oop pf-objects) ,x))
-(define-inlinable (G x) `(@ (guile) ,x))
+(define-inlinable (C x) `(@@ (language python compile) ,x))
+(define-inlinable (Y x) `(@@ (language python yield) ,x))
+(define-inlinable (T x) `(@@ (language python try) ,x))
+(define-inlinable (F x) `(@@ (language python for) ,x))
+(define-inlinable (E x) `(@@ (language python exceptions) ,x))
+(define-inlinable (L x) `(@@ (language python list) ,x))
+(define-inlinable (A x) `(@@ (language python array) ,x))
+(define-inlinable (S x) `(@@ (language python string) ,x))
+(define-inlinable (D x) `(@@ (language python def) ,x))
+(define-inlinable (Di x) `(@@ (language python dict) ,x))
+(define-inlinable (O x) `(@@ (oop pf-objects) ,x))
+(define-inlinable (G x) `(@ (guile) ,x))
(define (union as vs)
(let lp ((as as) (vs vs))
@@ -227,8 +230,24 @@
((startswith) (S 'py-startswith))
((swapcase) (S 'py-swapcase))
((translate) (S 'py-translate))
- ((zfill) (S 'py-zfill))))
+ ((zfill) (S 'py-zfill))
+
+ ;;DICTS
+ ((copy) (Di 'py-copy))
+ ((fromkeys) (Di 'py-fromkeys))
+ ((get) (Di 'py-get))
+ ((has_key) (Di 'py-has_key))
+ ((items) (Di 'py-items))
+ ((iteritems) (Di 'py-iteritems))
+ ((iterkeys) (Di 'py-iterkeys))
+ ((itervalues) (Di 'py-itervalues))
+ ((keys) (Di 'py-keys))
+ ((values) (Di 'py-values))
+ ((popitem) (Di 'py-popitem))
+ ((setdefault) (Di 'py-setdefault))
+ ((update) (Di 'py-update))))
+
(define (fastfkn x) (hash-ref fasthash x))
(define (get-kwarg vs arg)
@@ -296,7 +315,7 @@
`(#:vecref ,(exp vs n)))
((#:subscripts (n1 n2 n3))
- (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+ (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
`(#:vecsub
,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
@@ -306,7 +325,7 @@
n)))
((#:subscripts (n1 n2 n3) ...)
- (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+ (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
`(#:arraysub
,@(map (lambda (x y z)
`(,(exp vs x) ,(exp vs y) ,(exp vs z)))
@@ -433,7 +452,7 @@
`(,(L 'pylist-ref) ,e ,(exp vs n)))
((#:subscripts (n1 n2 n3))
- (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+ (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
`(,(L 'pylist-slice) ,e
,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
@@ -443,7 +462,7 @@
n))))
((#:subscripts (n1 n2 n3) ...)
- (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+ (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
`(,(A 'pyarray-slice) ,e
(list ,@(map (lambda (x y z)
`(list ,(exp vs x) ,(exp vs y) ,(exp vs z)))
@@ -921,7 +940,19 @@
(#:return
((_ . x)
`(,(fluid-ref return) ,@(map (g vs exp) x))))
-
+
+ (#:dict
+ ((_ . #f)
+ `(,(Di 'make-py-hashtable)))
+
+ ((_ (k . v) ...)
+ (let ((dict (gensym "dict")))
+ `(let ((,dict (,(Di 'make-py-hashtable))))
+ ,@(map (lambda (k v)
+ `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
+ k v)
+ ,dict))))
+
(#:comp
((_ x #f)
@@ -949,6 +980,7 @@
((hash-ref tagis tag (lambda y (warn "not tag in tagis") x)) x vs))
(#:True #t)
+ (#:None (E 'None))
(#:null ''())
(#:False #f)
(#:pass `(values))
@@ -1166,6 +1198,8 @@
(define-inlinable (non? x) (eq? x #:nil))
+(define (gentemp stx) (datum->syntax stx (gensym "x")))
+
(define-syntax for
(syntax-rules ()
((_ (x) (a) code #f #f)
@@ -1214,6 +1248,20 @@
(define-syntax for/adv1
(lambda (x)
(syntax-case x ()
+ ((_ (x ...) (in) code #f #f)
+ (with-syntax ((inv (gentemp #'in)))
+ #'(let ((inv (wrap-in in)))
+ (catch StopIteration
+ (lambda ()
+ (let lp ()
+ (call-with-values (lambda () (next inv))
+ (lambda (x ...)
+ (with-sp ((break (values))
+ (continue (values)))
+ code
+ (lp))))))
+ (lambda z (values))))))
+
((_ (x ...) (in ...) code #f #f)
(with-syntax (((inv ...) (generate-temporaries #'(in ...))))
#'(let ((inv (wrap-in in)) ...)
@@ -1228,6 +1276,22 @@
(lp))))))
(lambda z (values))))))
+ ((_ (x ...) (in) code #f #t)
+ (with-syntax ((inv (gentemp #'in)))
+ #'(let ((inv (wrap-in in)))
+ (let lp ()
+ (let/ec break-ret
+ (catch StopIteration
+ (lambda ()
+ (call-with-values (lambda () (next inv))
+ (lambda (x ...)
+ (let/ec continue-ret
+ (with-sp ((break (break-ret))
+ (continue (continue-ret)))
+ code))
+ (lp))))
+ (lambda z (values))))))))
+
((_ (x ...) (in ...) code #f #t)
(with-syntax (((inv ...) (generate-temporaries #'(in ...))))
#'(let ((inv (wrap-in in)) ...)
@@ -1261,6 +1325,41 @@
((x) #'(next x)))))
(syntax-case x ()
+ ((_ (x ...) (in) code else p)
+ (with-syntax ((inv (gentemp #'in)))
+ (with-syntax (((xx ...) (generate-temporaries #'(x ...))))
+ (if (syntax->datum #'p)
+ #'(let ((inv (wrap-in in)))
+ (let/ec break-ret
+ (let ((x #f) ...)
+ (catch StopIteration
+ (lambda ()
+ (let lp ()
+ (call-with-values (lambda () (next inv))
+ (lambda (xx ...)
+ (set! x xx) ...
+ (let/ec continue-ret
+ (with-sp ((break (break-ret))
+ (continue (continue-ret)))
+ code))
+ (lp)))))
+ (lambda q else)))))
+
+ #'(let ((inv (wrap-in in)))
+ (let ((x #f) ...)
+ (let/ec break-ret
+ (catch StopIteration
+ (lambda ()
+ (let lp ()
+ (call-with-values (lambda () (next inv))
+ (lambda (xx ...)
+ (set! x xx) ...
+ (with-sp ((break (break-ret))
+ (continue (values)))
+ code)
+ (lp)))))
+ (lambda e else)))))))))
+
((_ (x ...) (in ...) code else p)
(with-syntax (((inv ...) (generate-temporaries #'(in ...))))
(with-syntax ((get (gen #'(inv ...) #'(x ...)))
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 20:32:59 +0000