diff options
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/dict.scm | 4 | ||||
-rw-r--r-- | modules/language/python/for.scm | 13 | ||||
-rw-r--r-- | modules/language/python/list.scm | 23 | ||||
-rw-r--r-- | modules/language/python/module/itertools.scm | 155 | ||||
-rw-r--r-- | modules/language/python/property.scm | 11 | ||||
-rw-r--r-- | modules/language/python/range.scm | 3 | ||||
-rw-r--r-- | modules/language/python/string.scm | 11 | ||||
-rw-r--r-- | modules/language/python/yield.scm | 50 |
8 files changed, 233 insertions, 37 deletions
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index fe18583..a57b771 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -479,6 +479,10 @@ (define-class <hashiter> () l) +(name-object <hashiter>) +(cpit <hashiter> (o (lambda (o l) (slot-set! o 'l l)) + (list (slot-ref o 'l)))) + (define-method (wrap-in (t <hashtable>)) (let ((o (make <hashiter>))) diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index ec245df..0cb7afe 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -82,7 +82,18 @@ (define-class <scm-list> () l) (define-class <scm-string> () s i) - + +(name-object <scm-list>) +(name-object <scm-string>) +(cpit <scm-list> (o (lambda (o l) (slot-set! o 'l l)) + (list (slot-ref o 'l)))) +(cpit <scm-string> (o (lambda (o s i) + (slot-set! o 's s) + (slot-set! o 'i i)) + (list + (slot-ref o 's) + (slot-ref o 'i)))) + (define-method (next (l <scm-list>)) (let ((ll (slot-ref l 'l))) (if (pair? ll) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index dc63298..0cbd30a 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -487,6 +487,29 @@ (define-class <py-seq-iter> () o i n d) (define-class <py-list-iter> (<py-list>) i d) +(name-object <py-seq-iter>) +(name-object <py-list-iter>) + +(cpit <py-list-iter> (o (lambda (o i d) + (slot-set! o 'i i) + (slot-set! o 'd d)) + (list + (slot-ref o 'i) + (slot-ref o 'd)))) + +(cpit <py-seq-iter> (o (lambda (o oo i n d) + (slot-set! o 'o oo) + (slot-set! o 'i i) + (slot-set! o 'n i) + (slot-set! o 'd d)) + (list + (slot-ref o 'o) + (slot-ref o 'i) + (slot-ref o 'n) + (slot-ref o 'd)))) + + + (define-method (write (o <py-list-iter>) . l) (define port (if (null? l) #t (car l))) (for ((x : o)) ((l '())) diff --git a/modules/language/python/module/itertools.scm b/modules/language/python/module/itertools.scm new file mode 100644 index 0000000..d333ee9 --- /dev/null +++ b/modules/language/python/module/itertools.scm @@ -0,0 +1,155 @@ +(define-module (language python module itertools) + #:use-module (language python for) + #:use-module (language python yield) + #:use-module (language python def) + #:use-module (language python module copy) + #:use-module (language python module python) + #:use-module (language python module copy) + #:export (count cycle repeat accumulate chain compress dropwhile + filterfalse groupby isslice starmap takewhile + tee zip_longest)) + +(define count + (make-generator (start #:optional (step 1)) + (lambda* (yield start #:optional (step 1)) + (let lp ((i start)) + (yield i) + (lp (+ i step)))))) + +(define cycle + (make-generator + (lambda (yield p) + (let lp () + (for ((x : p)) () (yield x)) + (lp))))) + +(define repeat + (make-generator + (lambda* (yield e #:optional (n -1)) + (let lp ((i 0)) + (if (not (= i n)) + (begin + (yield e) + (lp (+ i 1)))))))) + +(define accumulate + (make-generator + (lambda* (yield p #:optional (f +)) + (for ((x : p)) ((s 0) (first? #t)) + (if first? + (begin + (yield x) + (values x #f)) + (let ((s (f x s))) + (yield s) + (values s #f))))))) + +(define-python-class chain () + (define __call__ + (make-generator + (lambda (yield . l) + (let lp ((l l)) + (if (pair? l) + (begin + (for ((x : (car l))) () + (yield x)) + (lp (cdr l)))))))) + (define from_iterable + (make-generator + (lambda (yield i) + (for ((ii : i)) () + (for ((x : ii)) () + (yield x))))))) + +(define compress + (make-generator + (lambda (yield data selectors) + (for ((d : data) (s : selectors)) () + (if s (yield d)))))) + +(define dropwhile + (make-generator + (lambda (yield pred seq) + (for ((x : seq)) ((start? #f)) + (if start? + (begin + (yield x) + #t) + (if (pred x) + #f + (begin + (yield x) + #t))))))) + +(define filterfalse + (make-generator + (lambda (yield pred seq) + (for ((x : seq)) + (if (not (f x)) (yield x)))))) + +(define none (list 'none)) +(define groupby + (make-generator + (lambda* (yield seq #:optional (key (lambda (x) x))) + (for ((x : seq)) ((k none)) ((l '())) + (if (eq? k none) + (values (key x) (list x)) + (let ((kk (key x))) + (if (equal? k kk) + (values k (cons x l)) + (begin + (yield k (reverse l)) + (values kk (list x)))))) + #:final + (if (not (eq? k none)) + (yield l (reverse l))))))) + + +(define isslice + (make-generator + (lambda* (yield seq #:optional (start 0) (stop -1) (step 1)) + (for ((x : seq) (i : (count 0))) + (if (= i stop) (break)) + (if (and (>= i start) + (= (modulo (- i start) step) 0)) + (yield x)))))) + +(define starmap + (make-generator + (lambda (yield f seq) + (for ((x : seq)) () (yield (f x)))))) + +(define takewhile + (make-generator + (lambda (yield pred seq) + (for ((x : seq)) () + (if (not (pred x)) (break)) + (yield x))))) + +(define tee + (make-generator + (lambda (yield it n) + (let lp ((i 0)) + (if (< i n) + (cons (deepcopy it) + (lp (+ i 1))) + '()))))) + +(define zip_longest + (make-generator + (lam (yield (* l) (= fillvalue None)) + (define mkit + (make-generator + (lambda (yield it) + (for ((x : it)) () + (yield (cons 1 x)) + (let lp () + (yield (cons 0 0)) + (lp))))) + (for ((x : (apply zip (map mkit l)))) + (if (= (apply + (map car x)) 0) + (break) + (yield (map (lambda (x) (if (= (car x) 0) fillvalue (cdr x))) + x)))))))) + + diff --git a/modules/language/python/property.scm b/modules/language/python/property.scm index eaefc74..aeb802c 100644 --- a/modules/language/python/property.scm +++ b/modules/language/python/property.scm @@ -3,8 +3,18 @@ #:use-module (oop goops) #:use-module (language python def) #:use-module (language python exceptions) + #:use-module (language python persist) #:export (property)) +(cpit <property> (o (lambda (o get set del) + (slot-set! o 'get get) + (slot-set! o 'set set) + (slot-set! o 'del del)) + (list + (slot-ref o 'get) + (slot-ref o 'set) + (slot-ref o 'del)))) + (define-python-class property (<property>) (define __init__ (lam (o (= getx None) (= setx None) (= delx None)) @@ -32,4 +42,3 @@ (define fset (lambda (self) (slot-ref self 'set))) (define fdel (lambda (self) (slot-ref self 'del)))) - diff --git a/modules/language/python/range.scm b/modules/language/python/range.scm index 45a1069..83c0313 100644 --- a/modules/language/python/range.scm +++ b/modules/language/python/range.scm @@ -5,6 +5,7 @@ #:use-module (language python list) #:use-module (language python yield) #:use-module (language python try) + #:use-module (language python persist) #:export (range)) (define-python-class range () @@ -195,7 +196,7 @@ 1 0)))) - +(name-object range) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 52aa2f1..74eb0d7 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -513,6 +513,17 @@ (equal? (slot-ref o 'str) x)) (define-class <string-iter> (<py-string>) str i d) +(name-object <string-iter>) +(cpit <string-iter> (o + (lambda (o str i d) + (slot-set! o 'str str) + (slot-set! o 'i i ) + (slot-set! o 'd d )) + (list + (slot-ref o 'str) + (slot-ref o 'i) + (slot-ref o 'd)))) + (define-method (write (o <string-iter>) . l) (define port (if (null? l) #t (car l))) diff --git a/modules/language/python/yield.scm b/modules/language/python/yield.scm index d32ff4b..9fb5d8e 100644 --- a/modules/language/python/yield.scm +++ b/modules/language/python/yield.scm @@ -4,6 +4,7 @@ #:use-module (oop goops) #:use-module (ice-9 control) #:use-module (ice-9 match) + #:use-module (language python persist) #:replace (send) #:export (<yield> in-yield define-generator @@ -30,8 +31,10 @@ (define-syntax make-generator (syntax-rules () - ((_ (args ...) closure) - (lambda (args ...) + ((_ closure) + (make-generator () closure)) + ((_ args closure) + (lambda a (let () (define obj (make <yield>)) (define ab (make-prompt-tag)) @@ -43,37 +46,7 @@ (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)))) - - ((_ (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 ... ***) + (apply closure yield a) (slot-set! obj 'closed #t) (throw StopIteration)) (letrec ((lam @@ -97,7 +70,16 @@ #'(define f (make-generator args (lambda (y . args) code ...))))))) (define-class <yield> () s k closed) - +(name-object <yield>) +(cpit <yield> (o (lambda (o s k closed) + (slot-set! o 's s ) + (slot-set! o 'k k ) + (slot-set! o 'closed closed)) + (list + (slot-ref o 's) + (slot-ref o 'k) + (slot-ref o 'closed)))) + (define-method (send (l <yield>) . u) (let ((k (slot-ref l 'k)) (s (slot-ref l 's)) |