itertools
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 22 Feb 2018 10:22:06 +0000 (11:22 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 22 Feb 2018 10:22:06 +0000 (11:22 +0100)
modules/language/python/dict.scm
modules/language/python/for.scm
modules/language/python/list.scm
modules/language/python/module/itertools.scm [new file with mode: 0644]
modules/language/python/property.scm
modules/language/python/range.scm
modules/language/python/string.scm
modules/language/python/yield.scm

index fe18583863a4d8ada3585c970462de1306e89a6d..a57b771c2f793b9623d2b8db87ffcfbf7061b060 100644 (file)
 
 
 (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>)))
index ec245dfc0dcd893870b7a3132be30cd38b0d9928..0cb7afec5a86248b808ebff0cff38f1726372360 100644 (file)
 
 (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)
index dc6329867bb79c8d2454a82cb7bf96859cd153a3..0cbd30aa80ad3964a8971d84bb0a587aceff5c0c 100644 (file)
 (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 (file)
index 0000000..d333ee9
--- /dev/null
@@ -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))))))))
+       
+  
index eaefc74284da5032eba999e1002fb7fbd223faf1..aeb802cfab63dba4d230e96a749374ed10ad5b85 100644 (file)
@@ -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))))
 
-
index 45a10696018e88a044aa1c781a2474a585181813..83c0313af85f79e4231b74e94610e6b714ae3665 100644 (file)
@@ -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 ()
           1
           0))))
 
-  
+(name-object range)
        
       
           
index 52aa2f16123ec7cf7dff80ba1656a5fb11351104..74eb0d7fb8133070eb76a4d747a5843cec239609 100644 (file)
   (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)))
index d32ff4b7b3e7d7b658683eacef19a1f7e62610d3..9fb5d8e2315d15c6bece0648b8627fb1b5847d00 100644 (file)
@@ -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
 
 (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))
                         (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
        #'(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))