summaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
Diffstat (limited to 'modules')
-rw-r--r--modules/language/python/compile.scm131
-rw-r--r--modules/language/python/def.scm13
-rw-r--r--modules/language/python/exceptions.scm5
-rw-r--r--modules/language/python/list.scm22
-rw-r--r--modules/language/python/string.scm3
-rw-r--r--modules/language/python/yield.scm97
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)
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 18:27:55 +0000