diff options
Diffstat (limited to 'modules/language/python/compile.scm')
-rw-r--r-- | modules/language/python/compile.scm | 131 |
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 ...))) |