refactoring functional objects

6 files changed, 67 insertions, 79 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index a040c7d..10320f5 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -407,7 +407,7 @@
        '()))))
 
 (define (kw->li dict)
-  (for ((k v : dict) (l '()))
+  (for ((k v : dict)) ((l '()))
     (cons* v (symbol->keyword (string->symbol k)) l)
     #:final
     (reverse l)))
@@ -528,12 +528,12 @@
                    `(,s/d ,v (,(C 'setwrap) ,u)))
                (if op
                    `(,s/d ,(exp vs kind)
-                           (,(O 'fset-x) ,v (list ,@(map q addings))
+                           (,(C 'fset-x) ,v ,addings
                             (,(C 'setwrap)
                              (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))))
                      
                    `(,s/d ,(exp vs kind)
-                          (,(O 'fset-x) ,v (list ,@(map q addings))
+                          (,(C 'fset-x) ,v ,addings
                            (,(C 'setwrap) ,u)))))
            
            (if (null? addings)
@@ -757,26 +757,24 @@
                           r))
                (class   (exp vs class))
                (parents (match parents
-                          (()
-                           (cons '() '()))
-                          (#f
-                           (cons '() '()))
+                          (() #f)
+                          (#f #f)
                           ((#:arglist . _)
-                           (get-addings vs (list parents)))))
-               (is-func (is-functional parents))
-               (parents (filt parents)))
+                           (get-addings vs (list parents))))))
           `(define ,class
              (,(C 'class-decor) ,decor
               (,(C 'with-class) ,class
-               (,(mk-p-class
-                ,class
-                (,(C 'ref-x) ,(C 'arglist->pkw) ,@parents)
+               (,(C 'mk-p-class)
+                ,class                
+                ,(if parents
+                     `(,(C 'ref-x) ,(C 'arglist->pkw) ,@parents)
+                     `(,(G 'cons) '() '()))
                 ,@(match (filter-defs (exp vs defs))
                     (('begin . l)
                      l)
                     ((('begin . l))
                      l)
-                    (l l))))))))))))
+                    (l l)))))))))))
 
  (#:scm
   ((_ (#:string _ s)) (with-input-from-string s read)))
@@ -1702,9 +1700,9 @@
     ((_ v (#:fast-id f _) . l)
      (ref-x (f v) . l))
     ((_ v (#:identifier x) . l)
-     (ref-x (refq v x) . l))
+     (ref-x (ref v x) . l))
     ((_ v (#:identifier x) . l)
-     (ref-x (refq v x) . l))
+     (ref-x (ref v x) . l))
     ((_ v (#:call-obj x) . l)
      (ref-x (x v) . l))
     ((_ v (#:call x ...) . l)
@@ -1721,7 +1719,7 @@
 (define-syntax del-x
   (syntax-rules ()
     ((_ v (#:identifier x))
-     (ref-x (refq v 'x)))
+     (ref-x (ref v 'x)))
     ((_ v (#:call-obj x))
      (values))
     ((_ v (#:call x ...))
@@ -1738,6 +1736,11 @@
     ((_ v (a ... b) val)
      (set-x-2 (ref-x v a ...) b val))))
 
+(define-syntax fset-x
+  (syntax-rules ()
+    ((_ v ((#:identifier x) ...) val)
+     ((@ (oop pf-objects) fset-x) v (list x ...) val))))
+
 (define-syntax set-x-2
   (syntax-rules ()
     ((_ v (#:fastfkn-ref f id) val)
@@ -1775,3 +1778,4 @@
   (syntax-rules ()
     ((_ s c)
      (syntax-parameterize ((*class* (lambda (x) #'s))) c))))
+
diff --git a/modules/language/python/dir.scm b/modules/language/python/dir.scm
index 30e47ac..da07642 100644
--- a/modules/language/python/dir.scm
+++ b/modules/language/python/dir.scm
@@ -15,23 +15,24 @@
 
 (define-method (dir) (pylist))
 
-(define (get-from-class c f)
-  (let lp ((c c))    
-    (hash-for-each f (slot-ref c 'h))
-    (let lpp ((pl (ref c '__parents__)))
-      (if (pair? pl)
-          (begin
-            (lp (car pl))
-            (lpp (cdr pl)))))))
+(define (chash-for-each f c)
+  (let ((h (slot-ref c 'h)))
+  (if (is-a? c <pf>)
+      (let ((hh (make-hash-table)))
+        (vhash-fold
+         (lambda (k v s)
+           (when (not (hash-ref hh k))
+             (hash-set! hh k #t)
+             (f k v))
+           s) #f h))
+      (hash-for-each f h))))
 
-(define (get-from-class-f c f)
-  (let lp ((c c))
-    (vhash-fold f 0 (slot-ref c 'h))
-    (let lpp ((pl (ref c '__parents__)))
-      (if (pair? pl)
-          (begin
-            (lp (car pl))
-            (lpp (cdr pl)))))))
+(define (get-from-class c f)
+  (let lp ((pl (ref c '__mro__)))
+    (if (pair? pl)
+        (begin
+          (chash-for-each f (car pl))
+          (lp (cdr pl))))))
 
 (define-method (dir (o <p>))
   (if (not (pyclass? o))
@@ -47,7 +48,7 @@
                        (c (ref o '__class__))
                        (l '())
                        (f (lambda (k v) (set! l (cons k l)))))
-                  (hash-for-each f (slot-ref o 'h))
+                  (chash-for-each f o)
                   (get-from-class c f)
                   (hash-for-each (lambda (k v) (pylist-append! l k)) h)
                   (to-pylist (map symbol->string (sort l <))))))
@@ -59,32 +60,6 @@
         (hash-for-each (lambda (k v) (set! l (cons k l))) h)
         (to-pylist (map symbol->string (sort l <))))))
 
-(define-method (dir (o <pf>))
-  (if (not (pyclass? o))
-      (aif it (ref o '__dir__)
-           (it)
-           (aif it (ref o '__dict__)
-                (let ((l (pylist)))
-                  (for ((k v : it)) ()
-                       (pylist-append! l k))
-                  (pylist-sort! l)
-                  l)
-                (let* ((h (make-hash-table))
-                       (c (ref o '__class__))
-                       (l '())
-                       (f (lambda (k v s) (set! l (cons k l)))))
-                  (vhash-fold f 0 (slot-ref o 'h))
-                  (get-from-class-f c f)
-                  (hash-for-each (lambda (k v) (pylist-append! l k)) h)
-                  (to-pylist (map symbol->string (sort l <))))))      
-      (let* ((h (make-hash-table))
-             (c o)
-             (l '())
-             (f (lambda (k v s) (pylist-append! h k #t))))
-        (get-from-class-f c f)
-        (hash-for-each (lambda (k v) (set! l (cons k l))) h)
-        (to-pylist (map symbol->string (sort l <))))))
-
 (define-method (dir (o <py-list>))
   (let ((l1 (pk (pylist-listing))))
     (if (is-a? o <p>)
@@ -172,6 +147,16 @@
     (let ((ret (to-pylist l)))
       (pylist-sort! ret)
       ret)))
-  
+
+(define-method (dir (o <procedure>))
+  (let ((ret (to-pylist (map (lambda (x)
+                               (let ((x (car x)))
+                                 (if (symbol? x)
+                                     (symbol->string x)
+                                     x)))
+                             (procedure-properties o)))))
+    (pylist-sort! ret)
+    ret))
+
                   
                           
diff --git a/modules/language/python/eval.scm b/modules/language/python/eval.scm
index 999acc0..53b4bce 100644
--- a/modules/language/python/eval.scm
+++ b/modules/language/python/eval.scm
@@ -1,5 +1,4 @@
 (define-module (language python eval)
-  #:use-module 
   #:use-module (parser stis-parser lang python3-parser)
   #:use-module (language python exceptions)
   #:use-module ((ice-9 local-eval) #:select ((the-environment . locals)))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index ded6b15..34c9ba0 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -11,7 +11,7 @@
   #:use-module (language python try)
   #:use-module (language python exceptions)
   #:export (to-list to-pylist <py-list> 
-            pylist-ref pylist-set! pylist-append!
+            pylist-append!
             pylist-slice pylist-subset! pylist-reverse!
             pylist-pop! pylist-count pylist-extend! len in
             pylist-insert! pylist-remove! pylist-sort!
@@ -822,11 +822,11 @@
   (let ((n1 (len o1))
         (n2 (len o2)))
     (for ((x1 : o1) (x2 : o2)) ()
-      (if (> x1 x2)
-          (break #t))
-      #:final
-      (>= n1 n2))))
-          
+         (if (> x1 x2)
+             (break #t))
+         #:final
+         (>= n1 n2))))
+
 (define-python-class list (<py-list>)
   (define  __init__
     (letrec ((__init__
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index bd68841..02f4e5e 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -3,8 +3,8 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 readline)
   #:use-module ((oop pf-objects) #:select
-                (<p> <property> class-method static-method refq
-                     py-super-mac))
+                (<p> <property> class-method static-method ref
+                     py-super-mac type object pylist-ref))
   #:use-module (language python exceptions       )
   #:use-module (language python def              )
   #:use-module (language python for              )
@@ -35,7 +35,7 @@
                              SyntaxError
                              len dir next dict None property range
                              tuple bytes bytearray eval locals globals
-                             compile exec type
+                             compile exec type object
                              )
   
   #:export (print repr complex float int
@@ -76,7 +76,7 @@
 (define-method (callable (x <applicable>       )) #t)
 (define-method (callable (x <primitive-generic>)) #t)
 (define-method (callable (x <p>))
-  (refq x '__call__))
+  (ref x '__call__))
                             
 (define chr integer->char)
   
@@ -100,17 +100,17 @@
 (define miss ((@ (guile) list) 'miss))
 
 (define* (getattr a b #:optional (k miss))
-  (let ((r (refq a (symbol->string b) k)))
+  (let ((r (ref a (symbol->string b) k)))
     (if (eq? r miss)
         (raise AttributeError "object/class ~a is missing attribute ~a" a b)
         r)))
 
 (define (hasattr a b)
-  (let ((r (refq a (symbol->string b) miss)))
+  (let ((r (ref a (symbol->string b) miss)))
     (not (eq? r miss))))
 
 (define-method (issubclass (sub <p>) (cls <p>))
-  (aif it (ref cl '__subclasscheck__)
+  (aif it (ref cls '__subclasscheck__)
        (it sub)
        (is-a? (ref sub '__goops__) (ref cls '__goops__))))
 
@@ -121,13 +121,13 @@
            (or
             (isinstance o (car cl))
             (isinstance o (cdr cl)))
-           (is-a? (ref (ref o '__class__) '__goops__) cl)))
+           (is-a? (ref (ref o '__class__) '__goops__) cl))))
 
 (define iter
   (case-lambda
     ((o) (aif it (wrap-in o)
               it
-              (aif get (refq o '__getitem__)
+              (aif get (ref o '__getitem__)
                    (make-generator iter
                                    (lambda (yield)
                                      (for () ((i 0))
diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm
index ef4abe7..e9d7c63 100644
--- a/modules/language/python/set.scm
+++ b/modules/language/python/set.scm
@@ -23,7 +23,7 @@
          (slot-set! self 'dict d)
 	 (for ((y : x)) ()
 	      (pylist-set! d y #t))))))
-  
+
   (define pop
     (lambda (self)
       (call-with-values (lambda () (pylist-pop! (slot-ref self 'dict)))
@@ -32,7 +32,7 @@
   (define  add
     (lambda (self k)
       (pylist-set! (slot-ref self 'dict) k #t)))
-  
+
   (define copy
     (lambda (self)
       (let ((dict (py-copy (slot-ref self 'dict))))