diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-23 20:57:50 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-23 20:57:50 +0200 |
commit | 5bc1a0f8dd7d6c07380b5e6c56d20a327c0ba587 (patch) | |
tree | 96d710188219f79cb5de488137d0681e35ac8cd6 /modules/language/python | |
parent | 6cb199ed027f0ce56dd2b3f1c94f7edc3a53c026 (diff) |
dicts now works almost entirely
Diffstat (limited to 'modules/language/python')
-rw-r--r-- | modules/language/python/compile.scm | 131 | ||||
-rw-r--r-- | modules/language/python/def.scm | 13 | ||||
-rw-r--r-- | modules/language/python/exceptions.scm | 5 | ||||
-rw-r--r-- | modules/language/python/list.scm | 22 | ||||
-rw-r--r-- | modules/language/python/string.scm | 3 | ||||
-rw-r--r-- | modules/language/python/yield.scm | 97 |
6 files changed, 215 insertions, 56 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 ...))) diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm index a9aa692..bc745f0 100644 --- a/modules/language/python/def.scm +++ b/modules/language/python/def.scm @@ -32,6 +32,16 @@ (() (values (reverse args) kw))))) +(define hset! hash-set!) + +(define (pytonize kw) + (hash-fold + (lambda (k v h) + (hset! h (symbol->string (keyword->symbol k)) v) + h) + (make-hash-table) + kw)) + (define-syntax lam (lambda (x) (define-syntax-rule (mk get-as (k v s) x y z w) @@ -76,7 +86,8 @@ (lambda (ww* kw) (let*-values (((ww* k) (take-1 ww* kw s v)) ...) - (let ((ww ww*)) + (let ((ww ww*) + (kw (pytonize kw))) code ...)))))))))))) (define-syntax-rule (def (f . args) code ...) (define f (lam args code ...))) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index 00e7074..a9b2c14 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -3,7 +3,8 @@ #:use-module (oop goops) #:export (StopIteration GeneratorExit RuntimeError Exception ValueError - IndexError)) + IndexError KeyError + None)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -12,6 +13,8 @@ (define RuntimeError 'RuntimeError) (define IndexError 'IndexError) (define ValueError 'ValueError) +(define None 'None) +(define KeyError 'KeyError) (define-python-class Exception () (define __init__ diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 498934f..094c786 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -2,21 +2,32 @@ #:use-module (ice-9 match) #:use-module (oop pf-objects) #:use-module (oop goops) + #:use-module (language python hash) #:use-module (language python exceptions) #:use-module (language python yield) #:use-module (language python for) #:use-module (language python try) #:use-module (language python exceptions) - #:export (to-list pylist-ref pylist-set! pylist-append! - pylist-slice pylist-subset! pylist-reverse! - pylist-pop! pylist-count pylist-extend! len in - pylist-insert! pylist-remove! pylist-sort! - pylist-index)) + #:export (to-list to-pylist + pylist-ref pylist-set! pylist-append! + pylist-slice pylist-subset! pylist-reverse! + pylist-pop! pylist-count pylist-extend! len in + pylist-insert! pylist-remove! pylist-sort! + pylist-index)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define-class <py-list> () vec n) +(define-method (py-hash (o <py-list>)) + (let ((n (min complexity (slot-ref o 'n))) + (v (slot-ref o 'vec))) + (let lp ((i 0) (s 0)) + (if (< i n) + (lp (+ i 1) + (xy (py-hash (vector-ref v i)) s)) + s)))) + (define-method (to-list x) (if (vector? x) (vector->list x) @@ -324,6 +335,7 @@ (vector-set! vec i (vector-ref vec k)) (vector-set! vec k swap)))))) + (define-method (pylist-reverse! (o <p>) . l) (apply (ref o 'reverse) l)) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 15dbe43..22c8b88 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -3,6 +3,7 @@ #:use-module (oop pf-objects) #:use-module (ice-9 match) #:use-module (language python list) + #:use-module (language python exceptions) #:use-module (parser stis-parser) #:export (py-format py-capitalize py-center py-endswith py-expandtabs py-find py-rfind @@ -13,8 +14,6 @@ py-rpartitio py-rindex py-split py-rsplit py-splitlines py-startswith py-swapcase py-translate py-zfill)) -(define None 'None) - (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define-syntax-rule (define-py (f n o . u) code ...) diff --git a/modules/language/python/yield.scm b/modules/language/python/yield.scm index 569775d..d32ff4b 100644 --- a/modules/language/python/yield.scm +++ b/modules/language/python/yield.scm @@ -5,7 +5,7 @@ #:use-module (ice-9 control) #:use-module (ice-9 match) #:replace (send) - #:export (<yield> + #:export (<yield> in-yield define-generator make-generator sendException sendClose)) @@ -28,38 +28,73 @@ (fluid-set! in-yield #t) ((apply abort-to-prompt YIELD x))))))) -(define (make-generator closure) - (lambda args - (let () - (define obj (make <yield>)) - (define ab (make-prompt-tag)) - (syntax-parameterize ((YIELD (lambda x #'ab))) - (slot-set! obj 'k #f) - (slot-set! obj 'closed #f) - (slot-set! obj 's - (lambda () - (call-with-prompt - ab +(define-syntax make-generator + (syntax-rules () + ((_ (args ...) closure) + (lambda (args ...) + (let () + (define obj (make <yield>)) + (define ab (make-prompt-tag)) + (syntax-parameterize ((YIELD (lambda x #'ab))) + (slot-set! obj 'k #f) + (slot-set! obj 'closed #f) + (slot-set! obj 's (lambda () - (apply closure yield args) - (slot-set! obj 'closed #t) - (throw StopIteration)) - (letrec ((lam - (lambda (k . l) - (fluid-set! in-yield #f) - (slot-set! obj 'k - (lambda (a) - (call-with-prompt - ab - (lambda () - (k a)) - lam))) - (apply values l)))) - lam)))) - obj)))) + (call-with-prompt + ab + (lambda () + (closure yield args ...) + (slot-set! obj 'closed #t) + (throw StopIteration)) + (letrec ((lam + (lambda (k . l) + (fluid-set! in-yield #f) + (slot-set! obj 'k + (lambda (a) + (call-with-prompt + ab + (lambda () + (k a)) + lam))) + (apply values l)))) + lam)))) + obj)))) -(define-syntax-rule (define-generator (f . args) code ...) - (define f (make-generator args (lambda args code ...)))) + ((_ (args ... . ***) closure) + (lambda (args ... . ***) + (let () + (define obj (make <yield>)) + (define ab (make-prompt-tag)) + (syntax-parameterize ((YIELD (lambda x #'ab))) + (slot-set! obj 'k #f) + (slot-set! obj 'closed #f) + (slot-set! obj 's + (lambda () + (call-with-prompt + ab + (lambda () + (apply closure yield args ... ***) + (slot-set! obj 'closed #t) + (throw StopIteration)) + (letrec ((lam + (lambda (k . l) + (fluid-set! in-yield #f) + (slot-set! obj 'k + (lambda (a) + (call-with-prompt + ab + (lambda () + (k a)) + lam))) + (apply values l)))) + lam)))) + obj)))))) + +(define-syntax define-generator + (lambda (x) + (syntax-case x () + ((_ (f y . args) code ...) + #'(define f (make-generator args (lambda (y . args) code ...))))))) (define-class <yield> () s k closed) |