itertools
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 29 Mar 2018 13:52:47 +0000 (15:52 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 29 Mar 2018 13:52:47 +0000 (15:52 +0200)
modules/language/python/module/functools.scm
modules/language/python/module/itertools.scm
modules/oop/pf-objects.scm

index e2a5ce17b8f4fdd516a823d4292eb52a77c541cd..f0ddf299c7169abad526eeb257fb58a012351eb8 100644 (file)
@@ -7,6 +7,7 @@
   #:use-module (language python module threading)
   #:use-module (language python module weakref)
   #:use-module (language python module collections)
+  #:use-module (language python module abc)
   #:use-module ((language python module python)
                #:select (iter getattr setattr repr isinstance callable
                               bool str int enumerate reversed hasattr
     
     (py-get registry match))
 
-(define (get_cache_token) #t)
-
 (define (singledispatch func)
     "Single-dispatch generic function decorator.
 
index d333ee99d9bfd7ebaf8acc9c8309daff1526568f..c32f99cf5277fdb5c68f6db65d57cc43884c6f0f 100644 (file)
@@ -1,23 +1,27 @@
 (define-module (language python module itertools)
+  #:use-module (oop pf-objects)
   #:use-module (language python for)
+  #:use-module (language python try)
   #: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)
+  #:use-module (language python exceptions)
+  #:use-module ((language python module python)
+               #:select (iter zip next))
+  
   #:export (count cycle repeat accumulate chain compress dropwhile
                  filterfalse groupby isslice starmap takewhile
-                 tee zip_longest))
+                 tee zip_longest product permutation combination
+                 combination_with_replacement))
 
 (define count
-  (make-generator (start #:optional (step 1))
+  (make-generator ll
     (lambda* (yield start #:optional (step 1))
       (let lp ((i start))
        (yield i)
        (lp (+ i step))))))
 
 (define cycle
-  (make-generator
+  (make-generator (p)
    (lambda (yield p)
      (let lp ()
        (for ((x : p)) () (yield x))
@@ -33,7 +37,7 @@
             (lp (+ i 1))))))))
 
 (define accumulate
-  (make-generator
+  (make-generator ll
    (lambda* (yield p #:optional (f +))
      (for ((x : p)) ((s 0) (first? #t))
          (if first?
@@ -46,7 +50,7 @@
 
 (define-python-class chain ()
   (define __call__
-    (make-generator
+    (make-generator ll
      (lambda (yield . l)
        (let lp ((l l))
         (if (pair? l)
               (for ((x : (car l))) ()
                    (yield x))
               (lp (cdr l))))))))
+
   (define from_iterable
-    (make-generator
+    (make-generator (i)
      (lambda (yield i)
        (for ((ii : i)) ()
            (for ((x : ii)) ()
                 (yield x)))))))
 
 (define compress
-  (make-generator
+  (make-generator (data selectors)
    (lambda (yield data selectors)
      (for ((d : data) (s : selectors)) ()
          (if s (yield d))))))
 
 (define dropwhile
-  (make-generator
+  (make-generator (pred seq)
    (lambda (yield pred seq)
      (for ((x : seq)) ((start? #f))
          (if start?
                    #t)))))))
 
 (define filterfalse
-  (make-generator
+  (make-generator (pred seq)
    (lambda (yield pred seq)
-     (for ((x : seq))
-         (if (not (f x)) (yield x))))))
+     (for ((x : seq)) ()
+         (if (not (pred x)) (yield x))))))
 
 (define none (list 'none))
 (define groupby
-  (make-generator
+  (make-generator l
    (lambda* (yield seq #:optional (key (lambda (x) x)))
-     (for ((x : seq)) ((k none)) ((l '()))
+     (for ((x : seq)) ((k none) (l '()))
          (if (eq? k none)
              (values (key x) (list x))
              (let ((kk (key x)))
      
      
 (define isslice
-  (make-generator
+  (make-generator l
    (lambda* (yield seq #:optional (start 0) (stop -1) (step 1))
-     (for ((x : seq) (i : (count 0)))
+     (for ((x : seq) (i : (count 0))) ()
          (if (= i stop) (break))
          (if (and (>= i start)
                   (= (modulo (- i start) step) 0))
      (for ((x : seq)) () (yield (f x))))))
 
 (define takewhile
-  (make-generator
+  (make-generator (pred seq)
    (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)))
-          '())))))
+  (lambda* (it #:optional (n 2))
+    (define (clone it)
+       (let ((l '())
+            (i  0)
+            (r '()))
+        (define (mk)
+          ((make-generator ()
+             (lambda (yield)
+               (let lp ((head #f))
+                 (if (and head (= i head))
+                     (let* ((x  (next it))
+                            (i0 (+ i 1)))
+                       
+                       (set! r (cons x r))
+                       (set! i i0)
+                       (yield x)
+                       (lp i0))
+                     (if (pair? l)
+                         (let ((x (car l)))
+                           (set! l (cdr l))
+                           (yield x)
+                           (lp #f))
+                         (if (null? r)
+                             (lp i)
+                             (begin
+                               (set! l (reverse r))
+                               (set! r '())
+                               (lp #f))))))))))
+        (values (mk) (mk))))
 
+     (if (<= n 0)
+        '()
+        (let lp ((i 1) (it (iter it)))
+          (if (< i n)
+              (call-with-values (lambda () (clone it))
+                (lambda (it1 it2)
+                  (cons it1 (lp (+ i 1) it2))))
+              (list it))))))
+          
 (define zip_longest
   (make-generator
    (lam (yield (* l) (= fillvalue None))
        (define mkit
-         (make-generator
+         (make-generator (it)
           (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))))))))
+              (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)))))))
        
   
+(def (product (* iterables) (= repeat 1))
+     ((make-generator ()
+      (lambda (yield)       
+       (let* ((iterables (map iter iterables))
+              (it0       (car iterables)))
+         (try
+          (lambda ()
+            (let lp ((it0 it0) (l (cdr iterables)) (rl (list it0)) (res '()))
+              (let ((x (next it0)))                    
+                (if (pair? l)
+                    (let ((it1.it2 (tee (car l))))
+                      (try
+                       (lambda ()
+                         (lp (cdr it1.it2) (cdr l)
+                             (cons (car it1.it2) rl)
+                             (cons x res)))
+                       (#:except StopIteration =>
+                                 (lambda x
+                                   (lp it0 l rl res)))))
+                    (begin
+                      (yield (reverse (cons x res)))
+                      (raise StopIteration))))))
+          (#:except StopIteration => values)))))))
+                       
+(def (permutation it (= r None))
+     ((make-generator ()
+      (lambda (yield)
+       (let* ((ll (for ((x : it)) ((l '())) (cons x l) #:final (reverse l)))
+              (N  (length ll)))
+         (let lp ((l ll) (ri '()) (rl '()) (i 0) (depth 0))
+           (if (pair? l)
+               (if (and (or (eq? r None) (< depth r)) (< depth N))
+                   (if (member i ri)
+                       (lp (cdr l) ri rl (+ i 1) depth)
+                       (let ((x (car l)))
+                         (lp ll (cons i ri) (cons x rl) 0 (+ depth 1))
+                         (lp (cdr l) ri rl (+ i 1) depth)))
+                   (yield (reverse rl))))))))))
+
+(def (combination it r)
+     ((make-generator ()
+      (lambda (yield)
+       (let* ((ll (for ((x : it)) ((l '()))
+                       (cons x l)
+                       #:final (reverse l)))
+             (N  (length ll)))
+         (let lp ((l ll) (rl '()) (depth 0))
+           (if (< depth r)
+               (if (>= (length l) (- r depth))
+                   (let ((x (car l)))
+                     (lp (cdr l) (cons x rl) (+ depth 1))
+                     (lp (cdr l) rl          depth)))
+               (yield (reverse rl)))))))))
+
+(def (combination_with_replacement it r)
+     ((make-generator ()
+      (lambda (yield)
+       (let* ((ll (for ((x : it)) ((l '()))
+                       (cons x l)
+                       #:final (reverse l)))
+             (N  (length ll)))
+         (let lp ((l ll) (rl '()) (depth 0))
+           (if (< depth r)
+               (if (pair? l)
+                   (let ((x (car l)))
+                     (lp l (cons x rl) (+ depth 1))
+                     (lp (cdr l) rl          depth)))
+               (yield (reverse rl)))))))))
+
index 0c82dfe6aa01a0f94397afaa7b5626293bb365c2..a1a5960c49313a57c3a01ae1d87fe54f9d23457f 100644 (file)
@@ -176,8 +176,12 @@ explicitly tell it to not update etc.
     (let((mro (ref class '__mro__)))
       (if (pair? mro)
          (let ((p (car mro)))
+           (aif it (ref p '__zub_classes__)
+                (hash-set! it class #t)
+                #f)
+           
            (aif it (ref p '__init_subclass__)
-                (apply it class #f kw)
+                (apply it class #f kw)
                 #f))))
     (set class '__mro__ (cons class (ref class '__mro__)))
     class))
@@ -754,19 +758,31 @@ explicitly tell it to not update etc.
   
   (define (gen-methods dict)
     (methods dict)
-    (pylist-set! dict '__goops__   goops)
-    (pylist-set! dict '__class__   meta)
-    (pylist-set! dict '__module__  (make-module))
-    (pylist-set! dict '__bases__   parents)
-    (pylist-set! dict '__fget__    #t)
-    (pylist-set! dict '__fset__    #t)
-    (pylist-set! dict '__name__    name)
-    (pylist-set! dict '__class__   meta)
-    (pylist-set! dict '__mro__     (get-mro parents))
+    (pylist-set! dict '__goops__    goops)
+    (pylist-set! dict '__class__    meta)
+    (pylist-set! dict '__zub_classes__ (make-weak-key-hash-table))
+    (pylist-set! dict '__module__   (make-module))
+    (pylist-set! dict '__bases__    parents)
+    (pylist-set! dict '__fget__     #t)
+    (pylist-set! dict '__fset__     #t)
+    (pylist-set! dict '__name__     name)
+    (pylist-set! dict '__qualname__ name)
+    (pylist-set! dict '__class__    meta)
+    (pylist-set! dict '__mro__      (get-mro parents))
     dict)
 
-  (with-fluids ((*make-class* #t))
-    (create-class meta name parents gen-methods kw)))
+  (let ((cl (with-fluids ((*make-class* #t))
+                        (create-class meta name parents gen-methods kw))))
+    (aif it (ref meta '__init_subclass__)
+        (let lp ((ps parents))
+          (if (pair? ps)
+              (let ((super (car ps)))
+                (it cl super)
+                (lp (cdr ps)))))
+        #f)
+    
+    cl))
+                   
 
 
 ;; Let's make an object essentially just move a reference
@@ -1110,18 +1126,40 @@ explicitly tell it to not update etc.
 
 (define (equal? x y) (or (eq? x y) (py-equal? x y)))
 
+(define (subclasses self)
+  (aif it (ref self '__zubclasses__)
+       (let ((h (make-hash-table)))
+        (let lp0 ((it it))
+          (let lp ((l (hash-fold
+                       (lambda (k v s)
+                         (hash-set! h k #t)
+                         (cons k s))
+                       '() it)))
+            (if (pair? l)
+                (begin
+                  (lp0 (car l))
+                  (lp (cdr l))))))
+
+        (hash-fold (lambda (k v s) (cons k s)) '() h))
+       '()))
+
 (set! type
       (make-python-class type ()
-       (define __new__ new-class0)              
+       (define __new__           new-class0)
+       (define __init_subclass__ (lambda x (values)))
+       (define ___zub_classes__  (make-weak-key-hash-table))
+       (define __subclasses__    subclasses)
         (define __call__
           (case-lambda
-            ((meta obj)
-             (ref obj '__class__ 'None))
-            ((meta name bases dict . keys)
-             (type- meta name bases dict keys))))))
+          ((meta obj)
+           (ref obj '__class__ 'None))
+          ((meta name bases dict . keys)
+           (type- meta name bases dict keys))))))
 (set type '__class__ type)
 
-(set! object (make-python-class object ()))
+(set! object (make-python-class object ()
+                               (define __subclasses__ subclasses)
+                               (define __weakref__   (lambda (self) self))))
 
 (name-object type)
 (name-object object)