deepcopy copy works

11 files changed, 279 insertions, 37 deletions

diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm
index 7700a00..1a0a8af 100644
--- a/modules/language/python/bytes.scm
+++ b/modules/language/python/bytes.scm
@@ -10,6 +10,7 @@
   #:use-module (language python exceptions)
   #:use-module (language python list)
   #:use-module (language python hash)
+  #:use-module (language python persist)
   #:export (<py-bytes> pybytes-listing bytes bytearray bytes->bytevector
 		       <py-bytearray> pybytesarray-listing))
 
@@ -24,6 +25,42 @@
 (define-class <py-bytes> () bytes)
 (define-class <py-bytearray> () n vec)
 
+(name-object <py-bytes>)
+(name-object <py-bytearray>)
+
+(cpit <py-bytes> (o (lambda (o n l)
+		      (slot-set! o 'bytes
+				 (let lp ((l l) (i 0) (b (b-make n)))
+				   (if (pair? l)
+				       (b-set! b i (car l))
+				       (lp (cdr l) (+ i 1) b)))))
+		    (let* ((b (slot-ref o 'bytes))
+			   (n (b-len b)))
+		      (list
+		       n
+		       (let lp ((i 0))
+			 (if (< i n)
+			     (cons (b-ref b i) (lp (+ i 1)))
+			     '()))))))
+
+(cpit <py-bytearray> (o (lambda (o n m l)
+			  (slot-set! o 'n m)
+			  (slot-set! o 'vec
+				     (let lp ((l l) (i 0) (b (b-make n)))
+				       (if (pair? l)
+					   (b-set! b i (car l))
+					   (lp (cdr l) (+ i 1) b)))))
+			(let* ((b (slot-ref o 'vec))
+			       (n (b-len b)))
+			  (list
+			   n
+			   (slot-ref o 'n)
+			   (let lp ((i 0))
+			     (if (< i n)
+				 (cons (b-ref b i) (lp (+ i 1)))
+				 '()))))))
+
+
 (define-method (b-get (o <bytevector>))
   o)
 (define-method (b-get (o <py-bytes>))
@@ -81,6 +118,8 @@
                         (lp (- i 1) (cdr r)))
                       (slot-set! self 'bytes bytes)))))))))))
 
+(name-object bytes)
+
 (define-python-class bytearray (<py-bytearray>)
   (define __init__
     (case-lambda
@@ -125,6 +164,8 @@
 		       (slot-set! self 'vec bytes)
 		       (slot-set! self 'n (b-len bytes)))))))))))))
 
+(name-object bytearray)
+
 (define-syntax-rule (define-py (f o . u) code ...)
   (begin
     (define-method (f (o <bytevector>) . u) code ...)
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index b9ab116..fe18583 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -6,6 +6,7 @@
   #:use-module (language python def)
   #:use-module (language python for)
   #:use-module (language python exceptions)
+  #:use-module (language python persist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 control)
   #:use-module (oop goops)
@@ -39,6 +40,27 @@
 (define H (hash 1333674836 complexity))
 
 (define-class <py-hashtable> () t h n)
+
+(name-object <py-hashtable>)
+
+(cpit <py-hashtable>
+      (o (lambda (o h n a)
+	   (slot-set! o 'h h)
+	   (slot-set! o 'n n)
+	   (slot-set! o 't
+		      (let ((t (make-hash-table)))
+			(let lp ((a a))
+			  (if (pair? a)
+			      (begin
+				(py-hash-set! t (caar a) (cdar a))
+				(lp (cdr a)))))
+			t)))
+	 (let ((t (slot-ref o 't)))
+	   (list
+	    (slot-ref o 'h)
+	    (slot-ref o 'n)
+	    (hash-fold (lambda (k v s) (cons (cons k v) s)) '() t)))))
+
 (define (make-py-hashtable)
   (let* ((o (make <py-hashtable>))
          (t (make-hash-table))
@@ -503,6 +525,8 @@
                       (slot-ref x 't)))))))
       __init__)))
 
+(name-object dict)
+
 (define (pyhash-listing)
   (let ((l (to-pylist
             (map symbol->string
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 5f4fbb7..dc63298 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -10,6 +10,7 @@
   #:use-module (language python for)
   #:use-module (language python try)
   #:use-module (language python exceptions)
+  #:use-module (language python persist)
   #:export (to-list to-pylist <py-list> 
             pylist-append!
             pylist-slice pylist-subset! pylist-reverse!
@@ -24,6 +25,14 @@
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-class <py-list>  () vec n)
+(name-object <py-list>)
+
+(cpit <py-list> (o (lambda (o n l)
+		      (slot-set! o 'n n)
+		      (slot-set! o 'vec (list->vector l)))
+		   ((@ (guile) list)
+		    (slot-ref o 'n)
+		    (vector->list (slot-ref o 'vec)))))
 
 (define-method (pylist-delete! (o <py-list>) k)
   (let* ((n (slot-ref o 'n))
@@ -841,7 +850,9 @@
                  (__init__ self)
                  (for ((i : it)) () (pylist-append! self i))))))
       __init__)))
-  
+
+(name-object list)
+
 (define pylist list)
 
 (define-method (py-class (o <py-list>) list))
diff --git a/modules/language/python/module/copy.scm b/modules/language/python/module/copy.scm
new file mode 100644
index 0000000..2673e7e
--- /dev/null
+++ b/modules/language/python/module/copy.scm
@@ -0,0 +1,7 @@
+(define-module (language python module copy)
+  #:export (Error copy deepcopy))
+
+(define Error 'CopyError)
+
+(define (copy     x) ((@@ (logic guile-log persistance)      copy) x))
+(define (deepcopy x) ((@@ (logic guile-log persistance) deep-copy) x))
diff --git a/modules/language/python/module/string.scm b/modules/language/python/module/string.scm
index 08dabcd..d867226 100644
--- a/modules/language/python/module/string.scm
+++ b/modules/language/python/module/string.scm
@@ -377,4 +377,6 @@
        (else
         (throw TypeError "conversion" conversion))))))
 
+(define (ascii x) (bytes x))
+
 (set! (@@ (language python string) formatter) (Formatter))
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index 521cc42..c81570d 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -5,6 +5,7 @@
   #:use-module (language python list)
   #:use-module (language python try)
   #:use-module (language python exceptions)
+  #:use-module (language python persist)
   #:export (py-int py-float py-complex
                    py-/ py-logand py-logior py-logxor py-abs py-trunc
                    py-lshift py-rshift py-mod py-floordiv py-round
@@ -19,6 +20,17 @@
 (define-class <py-float>   () x)
 (define-class <py-complex> () x)
 
+(name-object <py-int>)
+(name-object <py-float>)
+(name-object <py-complex>)
+
+(define-syntax-rule (mk <py-int>)
+  (cpit <py-int> (o (lambda (o x) (slot-set! o 'x x)) (list (slot-ref o 'x)))))
+
+(mk <py-int>)
+(mk <py-float>)
+(mk <py-complex>)
+
 (define-syntax-rule (b0 op)
   (begin
     (define-method (op (o1 <py-int>) o2)
@@ -235,6 +247,8 @@
                  (__init__ self (string->number n k))))))
       __init__)))
 
+(name-object int)
+
 (define (proj? x)
   (if (number? x)
       x
@@ -273,7 +287,9 @@
            (aif it (slot-ref n '__float__)
                 (slot-set! self 'x it)
                 (raise ValueError "could not make float from " n)))))))))
-  
+
+(name-object float)
+
 (define-python-class py-complex (<py-complex>)
   (define __init__
     (case-lambda
@@ -297,6 +313,8 @@
         (else
          (raise ValueError "could not make complex from " n m)))))))
 
+(name-object py-complex)
+
 (define-method (py-class (o <integer>    )) int)
 (define-method (py-class (o <real>       )) float)
 (u0 py-class)
diff --git a/modules/language/python/persist.scm b/modules/language/python/persist.scm
index ac7d7af..cf0f7c2 100644
--- a/modules/language/python/persist.scm
+++ b/modules/language/python/persist.scm
@@ -1,31 +1,63 @@
 (define-module (language python persist)
-  #:export ())
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (oop goops)
+  #:use-module (oop pf-objects)
+  #:use-module (logic guile-log persistance)
+  #:re-export(pcopyable? deep-pcopyable? pcopy deep-pcopy name-object)
+  #:export (reduce cp red cpit))
 
-(define-method (pcopyable      (<p> o)) #t)
-(define-method (deep_pcopyable (<p> o)) #t)
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
-(define-method (pcopy (<p> o))
+(define (vhash->assoc v)
+  (let ((t (make-hash-table)))
+    (vhash-fold
+     (lambda (k v s)
+       (if (hash-ref t k)
+	   s
+	   (begin
+	     (hash-set! t k #t)
+	     (cons (cons k v) s))))
+     '() v)))
+
+(define-method (pcopyable?      (o <p>)) #t)
+(define-method (deep-pcopyable? (o <p>)) #t)
+
+(define (cp o)
+  (match (red o)
+	 ((#:reduce mk f)
+	  (let ((oo (mk)))
+	    (for-each (lambda (x) (apply (car x) oo (cdr x))) f)
+	    oo))))
+
+(define (red o)
+  (list #:reduce
+	(let ((cl (class-of o)))
+	  (lambda () (make cl)))		
+	(reduce o)))
+
+(define-method (pcopy (o <p>))
   (list #:obj
-	(aif it (get o '__copy__)
+	(aif it (ref o '__copy__)
 	     (it)
-	     (copy o))))
+	     (cp o))))
 
-(define-method (deep-pcopy (<p> o) p?)
-  (aif it (and p? (get o '__deepcopy__))
+(define-method (deep-pcopy (o <p>) p?)
+  (aif it (and p? (ref o '__deepcopy__))
        (list #:obj  (it))
-       (list #:reduce
-	     (make (class-of o))
-	     (reduce o))))
+       (red o)))
 
 (define-method (reduce o) '())
-(define-method (reduce (<p> o))
+(define-method (reduce (o <p>))
   (cons*
    (cons
     (lambda (o args)
       (let ((h (make-hash-table)))
 	(slot-set! o 'h h)
 	(for-each
-	 (lambda (x) (hash-set! h (car x) (cdr x))))))
+	 (lambda (x) (hash-set! h (car x) (cdr x)))
+	 args)))
     (list
      (hash-fold
       (lambda (k v s) (cons (cons k v) s))
@@ -33,7 +65,12 @@
       (slot-ref o 'h))))
    (next-method)))
 
-(define-method (reduce (<pf> o))
+(define (fold f s l)
+  (if (pair? l)
+      (fold f (f (car l) s) (cdr l))
+      s))
+
+(define-method (reduce (o <pf>))
   (cons*
    (cons
     (lambda (o n args)
@@ -48,3 +85,22 @@
     (list (slot-ref o 'n) (vhash->assoc (slot-ref o 'h))))
    (next-method)))
      
+
+
+(define-syntax cpit
+  (lambda (x)
+    (syntax-case x ()
+      ((_ <c> (o lam a))
+       #'(begin    
+	   (define-method (pcopyable?      (o <c>)   ) #t)
+	   (define-method (deep-pcopyable? (o <c>)   ) #t)
+	   (define-method (pcopy           (o <c>)   ) (cp o))
+	   (define-method (deep-pcopy      (o <c>) p?) (red o))
+	   (define-method (reduce          (o <c>)   )
+	     (cons*
+	      (cons lam a)
+	      (next-method))))))))
+
+
+
+
diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm
index e9d7c63..25b02d7 100644
--- a/modules/language/python/set.scm
+++ b/modules/language/python/set.scm
@@ -7,9 +7,26 @@
   #:use-module (language python try)
   #:use-module (language python list)
   #:use-module (language python yield)
-  #:export(py-set))
+  #:use-module (language python persist)
+  #:export (py-set))
 
 (define-class <set> () dict)
+(name-object <set>)
+
+(cpit <set>
+      (o (lambda (o a)
+	   (slot-set! o 'dict
+		      (let ((h (make-py-hashtable)))
+			(let lp ((a a))
+			  (if (pair? a)
+			      (begin
+				(h-set! h (caar a) (cdar a))
+				(lp (cdr a))))))))
+	 (list
+	  (hash-fold (lambda (k v s) (cons (cons k v) s))
+		     '()
+		     (slot-ref o 'dict)))))
+
 
 (define miss (list 'miss))
  
@@ -213,4 +230,6 @@
                (yield k)
                (values))))))
 
+(name-object set)
+
 (define py-set set)
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 8d6d642..52aa2f1 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -7,6 +7,7 @@
   #:use-module (language python list)
   #:use-module (language python exceptions)
   #:use-module (language python for)
+  #:use-module (language python persist)
   #:export (py-format py-capitalize py-center py-endswith
                       py-expandtabs py-find py-rfind
                       py-isalnum py-isalpha py-isdigit py-islower
@@ -22,6 +23,10 @@
 
 
 (define-class <py-string> () str)
+(name-object <py-string>)
+
+(cpit <py-string> (o (lambda (o s) (slot-set! o 'str s))
+		     (list (slot-ref o 'str))))
 
 (define-syntax-rule (define-py (f n o . u) code ...)
   (begin
@@ -487,7 +492,13 @@
         ((is-a? s <py-string>)
          (slot-set! self 'str (slot-ref s 'src)))
         ((is-a? s <string>)
-         (slot-set! self 'str s)))))))
+         (slot-set! self 'str s))))))
+
+  (define __repr__
+    (lambda (self)
+      (slot-ref self 'str))))
+
+(name-object string)
 
 (define pystring string)
 
diff --git a/modules/language/python/tuple.scm b/modules/language/python/tuple.scm
index 5a36b4b..3ca4281 100644
--- a/modules/language/python/tuple.scm
+++ b/modules/language/python/tuple.scm
@@ -3,10 +3,18 @@
   #:use-module (oop pf-objects)
   #:use-module (language python hash)
   #:use-module (language python for)
+  #:use-module (language python persist)
   #:export (tuple <py-tuple> defpair))
 
 
 (define-class <py-tuple> () l)
+(name-object <py-tuple>)
+(cpit <py-tuple>
+      (o (lambda (o l)
+	   (slot-set! o 'l (map (lambda (x) x) l)))
+	 (list
+	  (slot-ref o 'l))))
+
 (define-method (py-hash (o <py-tuple>)) (py-hash (slot-ref o 'l)))
 (define-method (py-class (o <py-tuple>) tuple))
 (define-method (py-equal? (o1 <py-tuple>) o2) (equal? (slot-ref o1 'l) o2))
@@ -28,6 +36,8 @@
   (define __repr__
     (lambda (self) (format #f "~a" (slot-ref self 'l)))))
 
+(name-object tuple)
+
 (define-syntax-rule (defpair (f o . u) code ...)
   (begin
     (define-method (f (o <pair>)     . u)
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 4ed5680..15aad1f 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -2,7 +2,8 @@
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
-  #:replace (equal?)
+  #:use-module (logic guile-log persistance)
+  #:replace (equal?)  
   #:export (set ref make-p <p> <py> <pf> <pyf> <property>
                 call with copy fset fcall put put!
                 pcall pcall! get fset-x pyclass?                
@@ -55,6 +56,12 @@ explicitly tell it to not update etc.
 
 (define-class <property> () get set del)
 
+(name-object <p>)
+(name-object <pf>)
+(name-object <py>)
+(name-object <pyf>)
+(name-object <property>)
+
 (define (get-dict self name parents)
   (aif it (ref self '__prepare__)
        (it self name parents)
@@ -660,22 +667,48 @@ explicitly tell it to not update etc.
 ;; Let's make an object essentially just move a reference
 
 ;; the make class and defclass syntactic sugar
-(define-syntax-rule (mk-p-class name
-                                 parents
-                                 (ddef dname dval)
-                                ...)
-    (let ()
-      (define name 
-        (letruc ((dname dval) ...)
-           (make-p-class 'name
-                         parents
-                         (lambda (dict)
-                           (pylist-set! dict 'dname dname)
-                           ...
-                           (values)))))
-                          
-        
-      name))
+(define-syntax mk-p-class
+  (lambda (x)
+    (syntax-case x ()
+      ((_ name parents (ddef dname dval) ...)
+       (with-syntax (((ddname ...)
+		      (map (lambda (dn)
+			     (datum->syntax
+			      #'name
+			      (string->symbol
+			       (string-append
+				(symbol->string
+				 (syntax->datum #'name))
+				"-"
+				(symbol->string
+				 (syntax->datum dn))))))
+			   #'(dname ...)))
+		     (nname (datum->syntax
+			     #'name
+			     (string->symbol
+			      (string-append
+			       (symbol->string
+				(syntax->datum #'name))
+			       "-goops-class")))))
+	#'(let ()
+	    (define name 
+	      (letruc ((dname dval) ...)
+		      (make-p-class 'name
+				    parents
+				    (lambda (dict)
+				      (pylist-set! dict 'dname dname)
+				      ...
+				      (values)))))
+
+	    (begin
+	      (module-define! (current-module) 'ddname (ref name 'dname))
+	      (name-object ddname))
+	    ...
+
+	    (module-define! (current-module) 'nname (ref name '__goops__))
+	    (name-object nname)
+	    
+	    name))))))
 
 (define-syntax-rule (def-p-class name . l)
   (define name (mk-p-class name . l)))
@@ -731,8 +764,15 @@ explicitly tell it to not update etc.
 (define-syntax-rule (define-python-class name (parents ...) code ...)
   (define name (mk-p-class name (arglist->pkw (list parents ...)) code ...)))
 
-(define-syntax-rule (make-python-class name (parents ...) code ...)
-  (mk-p-class name (arglist->pkw (list parents ...)) code ...))
+(define-syntax make-python-class
+  (lambda (x)
+    (syntax-case x ()
+      ((_ name (parents ...) code ...)
+       #'(let* ((cl  (mk-p-class name
+				 (arglist->pkw (list parents ...))
+				 code ...)))
+	   cl)))))
+    
 
 (define (kind x)
   (and (is-a? x <p>)
@@ -952,3 +992,6 @@ explicitly tell it to not update etc.
 (set type '__class__ type)
 
 (set! object (make-python-class object ()))
+
+(name-object type)
+(name-object object)