abc compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 27 Feb 2018 12:46:43 +0000 (13:46 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 27 Feb 2018 12:46:43 +0000 (13:46 +0100)
modules/language/python/module/collections/abc.scm
modules/language/python/module/operator.scm
modules/oop/pf-objects.scm

index c0568343cb5f409b15025659b96f8923e961bc98..d526e73f2f7367a07e10a650bdb50e3687cb3a7b 100644 (file)
@@ -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"))))
 
   ;; 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
   (define __getitem__
     (lambda x (error "not implemented"))))
 
+
 (define-python-class MutableSequence (Sequence)
   ;; Mixin
   (define append
   (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)
   (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))))))
   
     (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)))))))
 
     (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)))))))
 
       (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
     (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
 (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)))))
 (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)))))
 (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)))))
             Sized Callable Collection Sequence MutableSequence
             ByteString Set MutableSet Mapping MutableMapping
             MappingView ItemsView KeysView ValuesView)
+
+
index 70a989dc7a36753e3d8d23097b33b49c4c8a1cba..a22fde4d133c42a0b39ed877ff8d7e690a3c3d68 100644 (file)
        __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))
 (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)
                     #: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)))
            (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)
         (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))
index 15aad1ffdc758cad4f9237ce8cb004eef3880a58..57289e01e822a47ed0328471f949935d041ca44c 100644 (file)
@@ -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)