itertools

3 files changed, 198 insertions, 54 deletions

diff --git a/modules/language/python/module/functools.scm b/modules/language/python/module/functools.scm
index e2a5ce1..f0ddf29 100644
--- a/modules/language/python/module/functools.scm
+++ b/modules/language/python/module/functools.scm
@@ -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
@@ -677,8 +678,6 @@
     
     (py-get registry match))
 
-(define (get_cache_token) #t)
-
 (define (singledispatch func)
     "Single-dispatch generic function decorator.
 
diff --git a/modules/language/python/module/itertools.scm b/modules/language/python/module/itertools.scm
index d333ee9..c32f99c 100644
--- a/modules/language/python/module/itertools.scm
+++ b/modules/language/python/module/itertools.scm
@@ -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)
@@ -54,21 +58,22 @@
 	       (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?
@@ -82,16 +87,16 @@
 		    #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)))
@@ -106,9 +111,9 @@
      
      
 (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))
@@ -120,36 +125,138 @@
      (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)))))))))
+
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 0c82dfe..a1a5960 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -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 p #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)