deepcopy copy works
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Feb 2018 12:57:57 +0000 (13:57 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Feb 2018 12:57:57 +0000 (13:57 +0100)
modules/language/python/bytes.scm
modules/language/python/dict.scm
modules/language/python/list.scm
modules/language/python/module/copy.scm [new file with mode: 0644]
modules/language/python/module/string.scm
modules/language/python/number.scm
modules/language/python/persist.scm
modules/language/python/set.scm
modules/language/python/string.scm
modules/language/python/tuple.scm
modules/oop/pf-objects.scm

index 7700a00966cc39676cafa6d420a14068c9502a02..1a0a8af3bf39b1cb30e4e61ce2b41f144c9854a5 100644 (file)
@@ -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))
 
 (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>))
                         (lp (- i 1) (cdr r)))
                       (slot-set! self 'bytes bytes)))))))))))
 
+(name-object bytes)
+
 (define-python-class bytearray (<py-bytearray>)
   (define __init__
     (case-lambda
                       (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 ...)
index b9ab1164e14f9adfc1781008133bfffa2d0df64b..fe18583863a4d8ada3585c970462de1306e89a6d 100644 (file)
@@ -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)
 (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))
                       (slot-ref x 't)))))))
       __init__)))
 
+(name-object dict)
+
 (define (pyhash-listing)
   (let ((l (to-pylist
             (map symbol->string
index 5f4fbb783c2873b4e5ec8d5f8d5e8d820a000ae0..dc6329867bb79c8d2454a82cb7bf96859cd153a3 100644 (file)
@@ -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!
 (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))
                  (__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 (file)
index 0000000..2673e7e
--- /dev/null
@@ -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))
index 08dabcd9351e199b7c02376c8079cd6b51811d79..d867226b30ce72ff4cacbd998e29ee35e02e0c16 100644 (file)
        (else
         (throw TypeError "conversion" conversion))))))
 
+(define (ascii x) (bytes x))
+
 (set! (@@ (language python string) formatter) (Formatter))
index 521cc42943503902e4faa6034c9425b7eb908ff7..c81570d8d18d23b373eef918bb47c55438734fc7 100644 (file)
@@ -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
 (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)
                  (__init__ self (string->number n k))))))
       __init__)))
 
+(name-object int)
+
 (define (proj? x)
   (if (number? x)
       x
            (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
         (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)
index ac7d7af047bb245158e4121104837c80184c4276..cf0f7c29f6cb63d9b46683ec2620722c0ac6a5b4 100644 (file)
@@ -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))
       (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)
     (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))))))))
+
+
+
+
index e9d7c6340604a1363a924aba14772d71c20dd7d8..25b02d71a9afca98d197693a08b13d0ec7c80c3b 100644 (file)
@@ -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))
  
                (yield k)
                (values))))))
 
+(name-object set)
+
 (define py-set set)
index 8d6d642be11c94c6e7f23f7fc75bbd4e76460a44..52aa2f16123ec7cf7dff80ba1656a5fb11351104 100644 (file)
@@ -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
 
 
 (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
         ((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)
 
index 5a36b4b0f7d764baac084cc7a008d4b767f014d2..3ca4281d02094c1d2e07ee353ed5e29433349417 100644 (file)
@@ -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)
index 4ed5680f6e63a38470b52ecaa8ef6e36040244ba..15aad1ffdc758cad4f9237ce8cb004eef3880a58 100644 (file)
@@ -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)