From 0f66dc88c5cc95f1dee7e4698c079a5554ddc886 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Tue, 27 Feb 2018 13:46:43 +0100
Subject: abc compiles

---
 modules/language/python/module/collections/abc.scm | 354 +++++++++++++++++----
 modules/language/python/module/operator.scm        |  56 +++-
 modules/oop/pf-objects.scm                         |   3 +-
 3 files changed, 334 insertions(+), 79 deletions(-)

(limited to 'modules')

diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm
index c056834..d526e73 100644
--- a/modules/language/python/module/collections/abc.scm
+++ b/modules/language/python/module/collections/abc.scm
@@ -1,15 +1,29 @@
 (define-module (language python module collections abc)
   #:use-module (oop pf-objects)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python exceptions)
+  #:use-module (language python def)
+  #:use-module (language python set)
+  #:use-module (language python list)
+  #:use-module (language python range)
+  #:use-module (language python yield)
+  #:use-module (language python persist)
   #:export (Container Hashable Iterable Iterator Reversable Generator
 		      Sized Callable Collection Sequence MutableSequence
 		      ByteString Set MutableSet Mapping MutableMapping
 		      MappingView ItemsView KeysView ValuesView))
 
+(define s:set (@@ (language python set) set))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+
 (define-python-class Container ()
   (define __containes__
     (lambda x (error "not implemented"))))
 
-(define-python.class Hashable ()
+(define-python-class Hashable ()
   (define __hash__
     (lambda x (error "not implemented"))))
 
@@ -59,34 +73,34 @@
   ;; Mixin
   (define __contains__
     (lambda (self x)
-      (let ((f (ref self '__getitem)))
-	(for ((i : (range (len self))))
-	     (if (equal? x (f i))
+      (let ((get (ref self '__getitem)))
+	(for ((i : (range (len self)))) ()
+	     (if (equal? x (get i))
 		 (break #t))
 	     #:final #f))))
 
   (define __iter__
     (lambda (self)
-      ((mk-iterator       
+      ((make-generator       
 	(lambda (yield)
 	  (let ((f (ref self '__getitem)))
-	    (for ((i : (range (len self))))
+	    (for ((i : (range (len self)))) ()
 		 (yield (f i)))))))))
 
   (define __reversed__
     (lambda (self)
-      ((mk-iterator
+      ((make-generator
 	(lambda (yield)
 	  (let ((f (ref self '__getitem)))
-	    (for ((i : (range (len self) 0 -1)))
+	    (for ((i : (range (len self) 0 -1))) ()
 		 (yield (f i)))))))))
 
   (define index
     (lambda (self x)
       (let ((f (ref self '__getitem__)))
-	(for ((i : (range (len self))))
+	(for ((i : (range (len self)))) ()
 	     (if (equal? x (f i))
-		 (break y))
+		 (break i))
 	     (raise IndexError)))))
 
   (define count
@@ -103,6 +117,7 @@
   (define __getitem__
     (lambda x (error "not implemented"))))
 
+
 (define-python-class MutableSequence (Sequence)
   ;; Mixin
   (define append
@@ -127,7 +142,7 @@
   (define remove
     (lambda (self x)
       (let ((f (ref self '__getitem__)))
-	(for ((i : (range (len self))))
+	(for ((i : (range (len self)))) ()
 	     (if (equal? x (f i))
 		 (begin
 		   ((ref self '__delitem__) i)
@@ -152,14 +167,17 @@
   (define insert
     (lambda x (error "not implemented"))))
 
+
 (define-python-class ByteString (Sequence))
 
 (define-python-class Set (Collection)
   ;; Mixins
   (define __le__
     (lambda (self o)
-      (let ((f (ref o '__contains__)))
-	(for ((x : ((ref self '__iter__))))
+      (let ((f (aif it (ref o '__contains__)
+		    it
+		    (lambda (x) (in x o)))))
+	(for ((x : self)) ()
 	     (if (not (f x))
 		 (break #f))))))
   
@@ -167,8 +185,10 @@
     (lambda (self o)
       (if (equal? (len self) (len o))
 	  #f
-	  (let ((f (ref o '__contains__)))
-	    (for ((x : ((ref self '__iter__))))
+	  (let ((f (aif it (ref o '__contains__)
+			it
+			(lambda (x) (in x o)))))
+	    (for ((x : self)) ()
 		 (if (not (f x))
 		     (break #f)))))))
 
@@ -176,8 +196,10 @@
     (lambda (self o)
       (if (not (equal? (len self) (len o)))
 	  #f
-	  (let ((f (ref o '__contains__)))
-	    (for ((x : ((ref self '__iter__))))
+	  (let ((f (aif it (ref o '__contains__)
+			it
+			(lambda (x) (in x o)))))
+	    (for ((x : self)) ()
 		 (if (not (f x))
 		     (break #f)))))))
 
@@ -189,71 +211,75 @@
       (if (equal? (len self) (len o))
 	  #f
 	  (let ((f (ref self '__contains__)))
-	    (for ((x : ((ref o '__iter__))))
+	    (for ((x : o)) ()
 		 (if (not (f x))
 		     (break #f)))))))
     
   (define __ge__
     (lambda (self o)
       (let ((f (ref self '__contains__)))
-	(for ((x : ((ref o '__iter__))))
+	(for ((x : o)) ()
 	     (if (not (f x))
 		 (break #f))))))
 
   (define __and__
     (lambda (self o)
-      (let ((f (ref o '__contains__))
-	    (s (set))
-	    (a (ref s 'add)))
-	(for ((x : ((ref self '__iter__)))) ()
+      (let* ((f (aif it (ref o '__contains__)
+		     it
+		     (lambda (x) (in x o))))
+	     (s (s:set))
+	     (a (ref s 'add)))
+	(for ((x : self)) ()
 	     (if (f x)
 		 (a x)))
 	s)))
   
   (define __or__
     (lambda (self o)
-      (let ((s (set))
-	    (a (ref s 'add)))
-	(for ((x : ((ref self '__iter__)))) ()
+      (let* ((s (s:set))
+	     (a (ref s 'add)))
+	(for ((x : self)) ()
 	     (a x))
-	(for ((x : ((ref o '__iter__)))) ()
+	(for ((x : o)) ()
 	     (a x))
 	s)))
       
   (define __sub__
     (lambda (self o)
-      (let ((f (ref o '__contains__))
-	    (s (set))
-	    (a (ref s 'add)))
-	(for ((x : ((ref self '__iter__)))) ()
+      (let* ((f (ref o '__contains__))
+	     (s (s:set))
+	     (a (ref s 'add)))
+	(for ((x : self)) ()
 	     (if (not (f x))
 		 (a x)))
 	s)))
 
   (define __xor__
     (lambda (self o)
-      (let ((fo (ref o    '__contains__))
-	    (fs (ref self '__contains__))
-	    (s (set))
-	    (a (ref s 'add)))
-	(for ((x : ((ref self '__iter__)))) ()
+      (let* ((fo (aif it (ref o    '__contains__)
+		      it
+		      (lambda (x) (in x o))))
+	     (fs (ref self '__contains__))
+	     (s  (s:set))
+	     (a  (ref s 'add)))
+	(for ((x : self)) ()
 	     (if (not (fo x))
 		 (a x)))
-	(for ((x : ((ref o '__iter__)))) ()
+	(for ((x : o)) ()
 	     (if (not (fs x))
 		 (a x)))
 	s)))
 
   (define disjoint
     (lambda (self o)
-      (let ((f (ref o '__contains__))
-	    (s (set))
-	    (a (ref s 'add)))
-	(for ((x : ((ref self '__iter__)))) ()
+      (let ((f (aif it (ref o '__contains__)
+		    it
+		    (lambda (x) (in x o)))))
+	(for ((x : self)) ()
 	     (if (f x)
 		 (break #f))
 	     #:final #t)))))
- 
+
 (define-python-class MutableSet (Set)
   ;; Abstract methods
   (define add
@@ -262,35 +288,212 @@
     (lambda x (error "not implemented")))
 
   ;; Mixins
-  (define clear)
-  (define pop)
-  (define remove)
-  (define __ior__)
-  (define __iand__)
-  (define __ixor__)
-  (define __isub__))
+  (define clear
+    (lambda (self)
+      (define discard (ref self 'discard))
+      (for ((x : (for ((x : self)) ((l '()))
+		      (cons x l)
+		      #:final l))) ()
+	    (discard x))))
+	   
+
+      
+  (define pop
+    (lambda (self)
+      (let ((x (for ((x : self)) ()
+		    (break x)
+		    #:final
+		    (raise KeyError))))
+	((ref self 'discard) x)
+	x)))
+  
+  (define remove
+    (lambda (self x)
+      (if (in x self)
+	  ((ref self 'discard) x)
+	  (raise KeyError))))
+	      
+  (define __ior__
+    (lambda (self o)
+      (let ((add (ref self 'add)))
+	(for ((x : o)) ()
+	     (add x)))))
+  
+  (define __iand__
+    (lambda (self o)
+      (define o-contains (aif it (ref o '__contains__)
+			       it
+			       (lambda (x) (in o x))))
+      
+      (define s-discard  (ref self 'discard))
+      
+      (for ((x : (for ((x : self)) ((l '()))
+		      (if (o-contains x)
+			  l
+			  (cons x l))))) ()
+
+	 (s-discard x))))
+
+
+  (define __ixor__
+    (lambda (self o)
+      (define o-contains  (aif it (ref o '__contains__)
+			       it
+			       (lambda (x) (in o x))))
+      
+      (define s-contains  (ref self '__contains__))
+      (define s-add       (ref self 'add))
+      (define s-discard   (ref self 'discard))
+      
+      (let ((rems (for ((x : self)) ((l '()))
+		       (if (o-contains  x)
+			   (cons x l)
+			   l)
+		       #:final l))
+	    (adds (for ((x : o)) ((l '()))
+		       (if (s-contains x)
+			   l
+			   (cons x l)))))
+	(let lp ((rems rems))
+	  (if (pair? rems)
+	      (begin
+		(s-discard (car rems))
+		(lp (cdr rems)))))
+	(let lp ((adds adds))
+	  (if (pair? adds)
+	      (begin
+		(s-add (car adds))
+		(lp (cdr adds))))))))
+
+	
+  (define __isub__
+    (lambda (self o)
+      (define o-contains (aif it (ref o '__contains__)
+			      it
+			      (lambda (x) (in o x))))
+
+      (define s-discard  (ref self 'discard))
+      
+      (let ((rems (for ((x : self)) ((l '()))
+		       (if (o-contains  x)
+			   (cons x l)
+			   l)
+		       #:final l)))
+	
+	(let lp ((rems rems))
+	  (if (pair? rems)
+	      (begin
+		(s-discard (car rems))
+		(lp (cdr rems)))))))))
 
 (define-python-class Mapping (Collection)
+  ;; Abstract
+  (define __getitem__
+    (lambda x (error "not implemented")))
+  
   ;; Mixins
-  (define __contains__)
-  (define keys)
-  (define items)
-  (define values)
-  (define get)
-  (define __eq__)
-  (define __ne__))
+  (define __contains__
+    (lambda (self x)
+      (try
+       (lambda () (ref self '__getitem__ x) #t)
+       (#:except KeyError => (lambda x #f)))))
+  
+  (define keys
+    (lambda (self)
+      (for ((k v : self)) ((l '()))
+	   (cons k l)
+	   #:final (reverse l))))
+
+  (define items
+    (lambda (self)
+      (for ((k v : self)) ((l '()))
+	   (cons (cons k v) l)
+	   #:final (reverse l))))
+
+  (define values
+    (lambda (self)
+      (for ((k v : self)) ((l '()))
+	   (cons v l)
+	   #:final (reverse l))))
+  
+  (define get
+    (lambda* (self x #:optional (d None))
+      (try
+       (lambda () (ref self '__getitem__ x))
+       (#:except KeyError => (lambda x d)))))
+	     
+  (define __eq__
+    (lambda (self o)
+      (define o-ref (aif it (ref o '__getitem__)
+			 it
+			 (lambda (x) (pylist-ref o x))))
+      (try
+       (lambda ()
+	 (for ((k v : o)) ()
+	      (if (not (equal? v (o-ref k)))
+		  (break #f))
+	      #:final #t))
+       (#:except KeyError => (lambda x #f)))))
+  
+  (define __ne__
+    (lambda (self o)
+      (not ((ref self '__eq__) o)))))
 
 (define-python-class MutableMapping (Mapping)
   ;; Abstracts
-  (define __setitem__)
-  (define __delitem__)
+  (define __setitem__ (lambda x (error "not implemented")))
+  (define __delitem__ (lambda x (error "not implemented")))
 
   ;; Mixins
-  (define pop)
-  (define popitem)
-  (define clear)
-  (define update)
-  (define setdefault))
+  (define pop
+    (lambda* (self k #:optional (d None))
+      (try
+       (lambda ()
+	 (define v (pylist-ref self k))
+	 ((ref self '__delitem__) k)
+	 v)
+       (#:except KeyError => (lambda x d)))))
+  
+  (define popitem
+    (lambda (self)
+      (for ((k v : self)) ()
+	   (break k v)
+	   #:final
+	   (raise KeyError))))
+  
+  (define clear
+    (lambda (self)
+      (define l (for ((k v : self)) ((l '()))
+		     (cons k l)
+		     #:final l))
+      (define rem (ref self '__delitem__))
+      (let lp ((l l))
+	(if (pair? l)
+	    (begin
+	      (rem (car l))
+	      (lp (cdr l)))))))
+  
+  (define update
+    (lam (self (* e) (** f))
+       (define add (ref self '__setitem__))
+       (let lp ((e e))
+	 (if (pair? e)
+	     (begin
+	       (for ((k v : (car e))) ()
+		    (add k v))
+	       (lp (cdr e)))))
+       (for ((k v : f)) ()
+	    (add k v))))
+	     
+  (define setdefault
+    (lambda* (self k #:optional (d None))
+	     (try
+	      (lambda () ((ref self '__getitem__) k))
+	      (#:except KeyError =>
+			(lambda x
+			  ((ref self '__setitem__) k d)
+			  d))))))
+	     
 
 (define-python-class MappingView (Sized)
   ;; Mixins
@@ -304,7 +507,13 @@
 (define-python-class ItemsView   (MappingView Set)
   ;; Mixins
   (define __contains__
-    (lambda (self x)))
+    (lambda (self x)
+      (let ((m (ref self '_mapping))
+	    (k (car x))
+	    (v (cdr x)))
+	(and (in k m)
+	     (equal? v (pylist-ref self k))))))
+       
   (define __iter__
     (lambda (self)
       ((ref (ref self '_mapping) 'items)))))
@@ -312,8 +521,10 @@
 (define-python-class KeysView    (MappingView Set)
   ;; Mixins
   (define __contains__
-    (lambda (self k)))
-      
+    (lambda (self k)
+      (let ((m (ref self '_mapping)))
+	(in k m))))
+          
   (define __iter__
     (lambda (self)
       ((ref (ref self '_mapping) 'keys)))))
@@ -321,8 +532,13 @@
 (define-python-class ValuesView  (MappingView)
     ;; Mixins
   (define __contains__
-    (lambda (self x)))
-  
+    (lambda (self x)
+      (let ((m (ref self '_mapping)))
+	(for ((k v : m)) ()
+	     (if (equal? v x)
+		 (break #t))
+	     #:final #f))))
+
   (define __iter__
     (lambda (self)
       ((ref (ref self '_mapping) 'values)))))
@@ -332,3 +548,5 @@
 	     Sized Callable Collection Sequence MutableSequence
 	     ByteString Set MutableSet Mapping MutableMapping
 	     MappingView ItemsView KeysView ValuesView)
+
+
diff --git a/modules/language/python/module/operator.scm b/modules/language/python/module/operator.scm
index 70a989d..a22fde4 100644
--- a/modules/language/python/module/operator.scm
+++ b/modules/language/python/module/operator.scm
@@ -29,6 +29,22 @@
 	__imod__ __imul__ __imatmul__ __ior__ __ipow__ __irshift__ __isub__
 	__itruediv__ __ixor__ ))
 
+(define (hash->assoc h)
+  (for ((k v : h)) ((l '()))
+       (cons (cons k v) l)
+       #:final (reverse l)))
+
+(define (asssoc->hash a)
+  (let ((h (make-hash-table)))
+    (let lp ((a a))
+      (if (pair? a)
+	  (begin
+	    (hash-set! h (caar a) (cdar a))
+	    (lp (cdr a)))))
+    h))
+	  
+		   
+
 ;; Comparison Operations
 (define-inlinable (lt a b) (<  a b))
 (define-inlinable (le a b) (<= a b))
@@ -89,26 +105,26 @@
 (define* (length_hint obj #:optional (default 0))
   (if (not (and (number? default) (integer? default)))
       (raise TypeError (format #f "default=~ a is not an integer" default)))
-  (let/ec ret (values)
-    #;(try
+  (let/ec ret
+    (try
      (lambda ()
        (ret (len obj)))
      
-     #:except TypeError =>
-     (lambda x (values)))
+     (#:except TypeError =>
+       (lambda x (values))))
 
-    #;(let ((hint
+    (let ((hint
 	   (try
 	    (lambda ()
 	      (ref obj '__length_hint__))
 
-	    #:except AttributeError =>
-	    (lambda x (ret default)))))
+	    (#:except AttributeError =>
+	      (lambda x (ret default))))))
       (let ((val (try
 		  (lambda () (hint))
 
-		  #:except TypeError =>
-		  (lambda x (ret default)))))
+		  (#:except TypeError =>
+		    (lambda x (ret default))))))
 	(cond
 	 ((eq? val NotImplemented)
 	  default)
@@ -147,6 +163,12 @@
 		     #:final (reverse l)))
 	      (set self '_call func))))))
 
+  (define __reduce__
+    (lambda (self)
+      (list (lambda (o data)
+	      (apply (ref o '__init__) data))
+	    (list (ref self '_attrs)))))
+
   (define __call__
     (lambda (self obj)
       ((ref self '_call) obj)))
@@ -178,6 +200,11 @@
 	    (set self '_items (cons item items))
             (set self '_call func)))))
 
+  (define __reduce__
+    (lambda (self)
+      (list (lambda (o data)
+	      (apply (ref o '__init__) data))
+	    (list (ref self '_items)))))
 
   (define __call__
     (lambda (self obj)
@@ -209,6 +236,17 @@
 	 (set self '_args    (cdr args))
 	 (set self '_kwargs  kwargs)))
 
+  (define __reduce__
+    (lambda (self)
+      (list
+       (lambda (o name args a)
+	 (let ((kwargs (assoc->hash kwargs)))
+	   (py-apply (ref methodcaller '__init__) o name (* args) (** kwargs))))
+       (list
+	(ref self '_name)
+	(ref self '_args)
+	(hash->assoc (ref self '_kwargs)))))))
+  
   (define __call__
     (lambda (self obj)
       (py-apply (getattr obj (ref self '_name))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 15aad1f..57289e0 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -609,8 +609,7 @@ explicitly tell it to not update etc.
   (define goopses (map (lambda (sups)
                          (aif it (ref sups '__goops__ #f)
                               it
-                              sups)
-                         sups)
+                              sups))
                        supers))
   (define parents (let ((p (filter-parents supers)))
                     (if (null? p)
-- 
cgit v1.2.3