set theory

6 files changed, 159 insertions, 146 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 8007449..fdc6309 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -11,12 +11,27 @@
   #:use-module (language python list)
   #:use-module (language python string)
   #:use-module (language python def)
-  #:use-module (language python set)
   #:use-module (ice-9 pretty-print)
   #:export (comp))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+(define-inlinable (C  x) `(@@ (language python compile) ,x))
+(define-inlinable (Y  x) `(@@ (language python yield)   ,x))
+(define-inlinable (T  x) `(@@ (language python try)     ,x))
+(define-inlinable (F  x) `(@@ (language python for)     ,x))
+(define-inlinable (E  x) `(@@ (language python exceptions) ,x))
+(define-inlinable (L  x) `(@@ (language python list)    ,x))
+(define-inlinable (A  x) `(@@ (language python array)   ,x))
+(define-inlinable (S  x) `(@@ (language python string)  ,x))
+(define-inlinable (Se x) `(@@ (language python set)     ,x))
+(define-inlinable (D  x) `(@@ (language python def)     ,x))
+(define-inlinable (Di x) `(@@ (language python dict)    ,x))
+(define-inlinable (O  x) `(@@ (oop pf-objects)          ,x))
+(define-inlinable (G  x) `(@  (guile)                   ,x))
+
+
+
 (define s/d 'set!)
 
 (define-syntax clear-warning-data
@@ -78,34 +93,13 @@
 
 (define (gen-sel vs e item)
   (match e
+    (#f item)
     ((#:cfor for-e in-e cont)
-     `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in)))
-       ,(if cont
-            (gen-sel vs cont item)
-            item)))
+     `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in-e))) ()
+       ,(gen-sel vs cont item)))
     ((#:cif cif cont)
      `(if ,(exp vs cif)          
-          ,(if cont
-               (gen-sel vs cont item)
-               item)))))
-
-(define (gen-sel vs e item)
-  (match e
-    ((#:cif . l)
-     (gen-cif vs e item
-
-(define-inlinable (C  x) `(@@ (language python compile) ,x))
-(define-inlinable (Y  x) `(@@ (language python yield)   ,x))
-(define-inlinable (T  x) `(@@ (language python try)     ,x))
-(define-inlinable (F  x) `(@@ (language python for)     ,x))
-(define-inlinable (E  x) `(@@ (language python exceptions) ,x))
-(define-inlinable (L  x) `(@@ (language python list)    ,x))
-(define-inlinable (A  x) `(@@ (language python array)   ,x))
-(define-inlinable (S  x) `(@@ (language python string)  ,x))
-(define-inlinable (D  x) `(@@ (language python def)     ,x))
-(define-inlinable (Di x) `(@@ (language python dict)    ,x))
-(define-inlinable (O  x) `(@@ (oop pf-objects)          ,x))
-(define-inlinable (G  x) `(@  (guile)                   ,x))
+          ,(gen-sel vs cont item)))))
 
 (define (union as vs)
   (let lp ((as as) (vs vs))
@@ -396,7 +390,7 @@
                                  (cdr addings)))
                          (cons v addings)))
             (v       (car v.add))
-            (addings (cdr addings))
+            (addings (cdr v.add))
             (addings (get-addings vs addings)))
        (define q (lambda (x) `',x))
        (if kind
@@ -947,8 +941,8 @@
  (#:list
   ((_ x (and e (#:cfor . _)))
    (let ((l (gensym "l")))
-     `(let ((,l ,((L 'to-pylist) '())))
-        ,(gen-sel vs e `(pylist-append ,l ,(exp vs x)))
+     `(let ((,l (,(L 'to-pylist) '())))
+        ,(gen-sel vs e `(,(L 'pylist-append!) ,l ,(exp vs x)))
         ,l)))
   
   ((_ . l)
@@ -965,7 +959,7 @@
                              `(cons ,(exp vs x) ,(lp l))))))))
  (#:tuple
   ((_ x (and e (#:cfor . _)))
-   (let ((l (gensym "l")))
+   (let ((l  (gensym "l")))
      `(let ((,l '()))
         ,(gen-sel vs e `(set! ,l (cons ,(exp vs x) ,l)))
         (reverse ,l))))
@@ -1042,7 +1036,7 @@
   ((_  (#:e k . v) (and e (#:cfor . _)))
    (let ((dict (gensym "dict")))
      `(let ((,dict (,(Di 'make-py-hashtable))))
-        ,(gen-sel vs e `(pylist-set! ,dict ,(exp vs k) ,(exp vs v)))
+        ,(gen-sel vs e `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
         ,dict)))
   
   ((_  (#:e k . v) ...)
@@ -1051,21 +1045,21 @@
         ,@(map (lambda (k v)
                  `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
                k v)
-        ,dict))))
+        ,dict)))
 
- ((_  k (and e (#:cfor . _)))
+  ((_  k (and e (#:cfor . _)))
    (let ((dict (gensym "dict")))
      `(let ((,dict (,(Se 'set))))
-        ,(gen-sel vs e `(,(O 'ref) ,dict 'add) ,(exp vs k))
+        ,(gen-sel vs e `((,(O 'ref) ,dict 'add) ,(exp vs k)))
         ,dict)))
   
- ((_  k ...)
+  ((_  k ...)
    (let ((set (gensym "dict")))
      `(let ((,set (,(Se 'set))))
-        ,@(map (lambda (k v)
-                 `((,(O 'ref) 'add) ,set ,(exp vs k)))
-               k v)
-        ,dict))))
+        ,@(map (lambda (k)
+                 `((,(O 'ref) ,set 'add) ,(exp vs k)))
+               k)
+        ,set))))
                   
                            
  (#:comp
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index b24031b..6c88ee4 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -10,10 +10,11 @@
   #:use-module (ice-9 control)
   #:use-module (oop goops)
   #:use-module (oop pf-objects)  
-  #:export (make-py-hashtable
+  #:export (make-py-hashtable <py-hashtable>
             py-copy py-fromkeys py-get py-has_key py-items py-iteritems
             py-iterkeys py-itervalues py-keys py-values
             py-popitem py-setdefault py-update py-clear
+            py-hash-ref
             ))
 
 (define (h x n) (modulo (py-hash x) n))
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index a9b2c14..4fffdab 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -2,7 +2,7 @@
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
   #:export (StopIteration GeneratorExit RuntimeError
-                          Exception ValueError
+                          Exception ValueError TypeError
                           IndexError KeyError
                           None))
 
@@ -15,6 +15,7 @@
 (define ValueError    'ValueError)
 (define None          'None)
 (define KeyError      'KeyError)
+(define TypeError     'TypeError)
 
 (define-python-class Exception ()
   (define __init__
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 8514310..f74e2b1 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -8,7 +8,7 @@
   #:use-module (language python for)
   #:use-module (language python try)
   #:use-module (language python exceptions)
-  #:export (to-list to-pylist
+  #:export (to-list to-pylist <py-list>
             pylist-ref pylist-set! pylist-append!
             pylist-slice pylist-subset! pylist-reverse!
             pylist-pop! pylist-count pylist-extend! len in
@@ -630,3 +630,6 @@
             #t
             (lp (+ i 1)))
         #f)))
+
+(define-method (in x (o <p>))
+  ((ref o '__contains__) x))
diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm
index 5a9cddc..3164c8f 100644
--- a/modules/language/python/set.scm
+++ b/modules/language/python/set.scm
@@ -1,15 +1,19 @@
-(define-module (language prolog set)
+(define-module (language python set)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
-  #:use-module (language prolog dict)
-  #:use-module (language prolog for)
-  #:use-module (language prolog try)
-  #:use-module (language prolog list)
-  #:(set))
+  #:use-module (language python exceptions)
+  #:use-module (language python dict)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python list)
+  #:use-module (language python yield)
+  #:export(set))
 
-(define-class <set> () 'dict)
+(define-class <set> () dict)
 
-(define-class set (<set>)
+(define miss (list 'miss))
+
+(define-python-class set (<set>)
   (define __init__
     (case-lambda
       ((self)       
@@ -20,38 +24,38 @@
          (cond
           ((or (is-a? x <py-list>) (pair? x) (string? x))
            (for ((y : x)) ()
-                (pyhash-set! d y #t)))
-          ((is-a? x <py-hash>)
+                (pylist-set! d y #t)))
+          ((is-a? x <py-hashtable>)
            (slot-set! self 'dict x))
           (else
            (raise TypeError)))))))
 
   (define pop
     (lambda (self)
-      (call-with-values (lambda () (pyhash-pop! (slot-ref self 'dict)))
+      (call-with-values (lambda () (pylist-pop! (slot-ref self 'dict)))
         (lambda (k v) k))))
   
   (define  add
     (lambda (self k)
-      (pyhash-set! (slot-ref self 'dict) k #t)))
+      (pylist-set! (slot-ref self 'dict) k #t)))
   
   (define copy
     (lambda (self)
-      (let ((dict (pyhash-copy (slot-ref self 'dict))))
+      (let ((dict (py-copy (slot-ref self 'dict))))
         (set dict))))
 
   (define difference
     (lambda (self . l)
       (let* ((d (slot-ref self 'dict))
-             (r (pyhash-copy d)))
+             (r (py-copy d)))
         (let lp ((l l))
           (if (pair? l)
               (begin
                 (for ((x : (car l))) ()
-                     (when (not (eq? miss (pyhash-ref d x miss)))
-                       (pyhash-remove! r x)))
+                     (when (in x d)
+                       (pylist-delete! r x)))
                 (lp (cdr l)))))
-        r)))
+        (set r))))
 
   (define difference_update
     (lambda (self . l)
@@ -60,8 +64,8 @@
           (if (pair? l)
               (begin
                 (for ((x : (car l))) ()
-                     (when (not (eq? miss (pyhash-ref d x miss)))
-                       (pyhash-remove! r x)))
+                     (when (in x r)
+                       (pylist-delete! r x)))
                 (lp (cdr l)))))
         (values))))
   
@@ -71,28 +75,28 @@
         (let lp ((l l))
           (if (pair? l)
               (begin
-                (pyhash-remove! d (car l))
+                (pylist-delete! r (car l))
                 (lp (cdr l))))))))
   
   (define intersection
     (lambda (self . l)
       (let* ((d (slot-ref self 'dict))
-             (r (pyhash-copy d)))
+             (r (py-copy d)))
         (let lp ((l l))
           (if (pair? l)
               (let ((y (car l)))
-                (for ((k : r)) ((dels '()))
-                  (if (not (eq? miss (pylist-ref y k miss)))
-                      (cons k dels)
-                      dels)
-                  #:finally
+                (for ((k v : r)) ((dels '()))
+                     (if (not (__contains__ y k))
+                         (cons k dels)
+                         dels)
+                  #:final
                   (let lp ((dels dels))
                     (if (pair? dels)
                         (begin
-                          (pylist-remove! r (car dels))
+                          (pylist-delete! r (car dels))
                           (lp (cdr dels))))))
                 (lp (cdr l)))))
-        r)))
+        (set r))))
 
   (define intersection_update
     (lambda (self . l)
@@ -100,15 +104,15 @@
         (let lp ((l l))
           (if (pair? l)
               (let ((y (car l)))
-                (for ((k : r)) ((dels '()))
-                  (if (not (eq? miss (pylist-ref y k miss)))
+                (for ((k v : r)) ((dels '()))
+                  (if (not (__contains__ y k))
                       (cons k dels)
                       dels)
-                  #:finally
+                  #:final
                   (let lp ((dels dels))
                     (if (pair? dels)
                         (begin
-                          (pylist-remove! r (car dels))
+                          (pylist-delete! r (car dels))
                           (lp (cdr dels))))))
                 (lp (cdr l))))))))
 
@@ -121,34 +125,34 @@
             (let ((xx x))
               (set! x r)
               (set! r xx)))
-        (for ((k : r)) ()
-             (if (not (eq? miss (pylist-ref x 'k miss)))
+        (for ((k v : r)) ()
+             (if (in k x)
                  (break #f))
-             #:finally
+             #:final
              #t))))
   
   (define issubset
     (lambda (self x)
       (let* ((r  (slot-ref self 'dict)))
-        (for ((k : r))
-          (if (eq? miss (pylist-ref x 'k miss))
+        (for ((k v : r)) ()
+          (if (not (__contains__ x k))
               (break #f))
-          #:finally
+          #:final
           #t))))
 
   (define issuperset
     (lambda (self x)
-      (let* ((r  (slot-ref self 'dict)))
-        (for ((x : r))
-          (if (eq? miss (pylist-ref r 'k miss))
+      (let* ((r (slot-ref self 'dict)))
+        (for ((x v : r)) ()
+          (if (not (in x r))
               (break #f))
-          #:finally
+          #:final
           #t))))
 
   (define remove
     (lambda (self x)
       (let* ((r (slot-ref self 'dict)))
-        (if (eq? miss (pylist-ref r x miss))
+        (if (not (in x r))
             (raise KeyError "missing key in set at remove")
             (pylist-delete! r x)))))
 
@@ -164,14 +168,14 @@
   (define union
     (lambda (self . l)
       (let* ((d (slot-ref self 'dict))
-             (r (pyhash-copy d)))
+             (r (py-copy d)))
         (let lp ((l l))
           (if (pair? l)
               (begin
                 (for ((k : (car l))) ()
                      (pylist-set! r k #t))
                 (lp (cdr l)))
-              r)))))
+              (set r))))))
   
   (define update
     (lambda (self . l)
@@ -179,28 +183,31 @@
         (let lp ((l l))
           (if (pair? l)
               (begin
-                (for ((k : (car l))) ()
+                (for ((k v : (car l))) ()
                      (pylist-set! r k #t))
                 (lp (cdr l)))
               (values))))))
+  
+  (define __repr__
+    (lambda (self)
+      (let* ((r (py-keys (slot-ref self 'dict)))
+             (n (len r))
+             (l (to-list r)))
+        (cond
+         ((= n 0)
+          (format #f "set([])"))
+         (else
+          (format #f "set([~a~{, ~a~}])" (car l) (cdr l)))))))
 
-  (define __repr__(self):
-    (let ((r (py-keys (slot-ref self 'dicy)))
-          (n (len r))
-          (l (to-list r)))
-      (cond
-       ((= n 0)
-        (format #f "set([])"))
-       (else
-        (format #f "set([~a ~{, ~a~}])" (car l) (cdr l))))))
-
+  (define __contains__
+    (lambda (self x)
+      (let* ((d (slot-ref self 'dict))
+             (t (slot-ref d    't)))
+        (not (eq? miss (py-hash-ref t x miss))))))
+                
   (define __iter__
     (make-generator (self)
-      (lambda (yield self)
-        (for ((k : (slot-ref self 'dict))) ()
-             (yield k)
-             (values))))))
-       
-
-    
-        
+        (lambda (yield self)
+          (for ((k v : (slot-ref self 'dict))) ()
+               (yield k)
+               (values))))))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index d22a9a0..8e08b3e 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -67,15 +67,15 @@ explicitly tell it to not update etc.
     class))
 
 ;; Make an empty pf object
-(define (make-pf)
-  (define r (make-pyclass <pf>))
+(define* (make-pf #:optional (class <pf>))
+  (define r (make-pyclass class))
   (slot-set! r 'h vlist-null)
   (slot-set! r 'size 0)
   (slot-set! r 'n 0)
   r)
 
-(define (make-p)
-  (define r (make-pyclass <p>))
+(define* (make-p #:optional (class <p>))
+  (define r (make-pyclass class))
   (slot-set! r 'h (make-hash-table))
   r)
 
@@ -517,10 +517,10 @@ explicitly tell it to not update etc.
   (slot-set! out 'size s)
   out)
 
-(define (union- x y)
+(define (union- class x y)
   (define hx (slot-ref x 'h))
   (define hy (slot-ref y 'h))  
-  (define out (make-p))
+  (define out (make-p class))
   (define h  (slot-ref out 'h))
   (hash-for-each (lambda (k v) (hash-set! h k v)) hy)
   (hash-for-each (lambda (k v) (hash-set! h k v)) hx)
@@ -540,12 +540,12 @@ explicitly tell it to not update etc.
          (with-syntax (((sups (... ...)) (generate-temporaries
                                           #'(supers (... ...)))))
            #'(let ((sups supers) (... ...))
-               (define class dynamic)
                (define name (make-class (list sups (... ...) <pf>) '()))
-
+               (define class (dynamic name))
                (define __const__
                  (union const
-                        (let lp ((sup (list sups (... ...))))
+                        (let lp ((sup (filter-parents
+                                       (list sups (... ...)))))
                           (if (pair? sup)
                               (union (ref (car sup) '__const__  null)
                                      (lp (cdr sup)))
@@ -555,17 +555,28 @@ explicitly tell it to not update etc.
                (set  class '__const__    __const__)
                (set  class '__goops__    name)
                (set  class '__name__     'name)
-               (set  class '__parents__  (list sups (... ...)))
+               (set  class '__parents__  (filter-parents
+                                          (list sups (... ...))))
                
+               (set class '__goops__    name)
                (set  __const__ '__name__    'name)
-               (set  __const__ '__class__   class)
-               (set  __const__ '__parents__ (list sups (... ...)))
+               (set  __const__ '__goops__   class)
+               (set  __const__ '__parents__ (filter-parents
+                                             (list sups (... ...))))
                (set  __const__ '__goops__   name)
                class)))))))
 
 (mk-pf make-pf-class <pf>)
 (mk-pf make-pyf-class <pyf>)
 
+(define (filter-parents l)
+  (let lp ((l l))
+    (if (pair? l)
+        (if (is-a? (car l) <p>)
+            (cons (car l) (lp (cdr l)))
+            (lp (cdr l)))
+        '())))
+
 (define-syntax-rule (mk-p make-p-class <p>)
   (define-syntax make-p-class
     (lambda (x)
@@ -574,23 +585,19 @@ explicitly tell it to not update etc.
          (with-syntax (((sups (... ...)) (generate-temporaries
                                           #'(supers (... ...)))))
            #'(let ((sups supers) (... ...))
-               (define class dynamic)
-               (define name (make-class (list (ref sups '__goops__ #f)
-                                              (... ...) <p>) '()))
+               (define name (make-class (list
+                                         (if (is-a? sups <p>)
+                                             (aif it (ref sups '__goops__ #f)
+                                                  it
+                                                  sups)
+                                             sups)
+                                         (... ...) <p>) '()))
                
-               (set! class
-                 (union- const
-                         (let lp ((sup (list sups (... ...))))
-                           (if (pair? sup)
-                               (union- (car sup)
-                                       (lp (cdr sup)))
-                               (make-p)))))
-               
-
+               (define class (dynamic <p>))
+               (set class '__name__    'name)
+               (set class '__class__   #f)
                (set class '__goops__    name)
-               (set class '__name__     'name)
-               (set class '__parents__  (list sups (... ...)))
-               
+               (set class '__parents__  (filter-parents (list sups (... ...))))
                class)))))))
 
 (mk-p  make-p-class  <p>)
@@ -606,16 +613,16 @@ explicitly tell it to not update etc.
                                    #:dynamic
                                    ((ddef dname dval) (... ...)))
     (let ()
-      (define name
-        (make-pf-class name
-                       (letrec ((mname sval) ...)
+      (define name 
+        (letrec ((mname sval) (... ...) (dname dval) (... ...))
+          (make-pf-class name
                          (let ((s (make-pf)))
                            (set s 'mname mname) (... ...)
-                           s))
-                       (letrec ((dname dval) ...)
-                         (let ((d (make-pf)))
-                           (set d 'dname dname) (... ...)
-                           d)                 
+                           s)
+                         (lambda (class)
+                           (let ((d (make-pf class)))
+                             (set d 'dname dname) (... ...)
+                             d))                 
                          (parents (... ...)))))
       name)))
 
@@ -657,11 +664,11 @@ explicitly tell it to not update etc.
     'none)))
 
 (define (print o l)
-  (define p1 (if (pyclass? o) "Class" "Object"))
-  (define p2 (if (pyclass? o) "Class" "Object"))
+  (define p1 (if (pyclass? o) "C" "O"))
+  (define p2 (if (pyclass? o) "C" "O"))
   (define port (if (pair? l) (car l) #t))
   (format port "~a"
-          (aif it (ref o '__repr__ #f)
+          (aif it (if (pyclass? o) #f (ref o '__repr__ #f))
                (format
                 #f "~a(~a)<~a>" p1 (get-type o) (it))
                (format
@@ -674,9 +681,9 @@ explicitly tell it to not update etc.
   (define name
     (mk-py-class name parents
                  #:const
-                 (code ...)
+                 ()
                  #:dynamic
-                 ())))
+                 (code ...))))
 
 (define (pyclass? x)
    (and (is-a? x <p>) (not (ref x '__class__))))