small steps

5 files changed, 118 insertions, 76 deletions

diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index 977d5e1..f76e2ad 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -13,7 +13,7 @@
   #:use-module (oop goops)
   #:use-module (oop pf-objects)  
   #:export (make-py-hashtable <py-hashtable>
-            py-copy py-fromkeys py-get py-has_key py-items py-iteritems
+            py-copy py-fromkeys 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 dict pyhash-listing
diff --git a/modules/language/python/hash.scm b/modules/language/python/hash.scm
index 4fab02d..168cd44 100644
--- a/modules/language/python/hash.scm
+++ b/modules/language/python/hash.scm
@@ -42,7 +42,7 @@
           s))))
 
 (define-method (py-hash (x <p>))
-  (aif it (pk 'it (ref x '__hash__))
+  (aif it (ref x '__hash__)
        (pk 'hash (it))
        (next-method)))
 
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index ab963d1..5c5d630 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -7,6 +7,7 @@
   #:use-module (language python yield)
   #:use-module (language python try)
   #:use-module (language python dir)
+  #:use-module (language python list)
   #:export (Module private public import))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
@@ -121,7 +122,6 @@
       (rawset self '_private #f)
       (if (not (rawref self '_module))
 	  (begin
-	    (set self '__dict__ self)
 	    (set self '__name__ (string-join
 				 (map symbol->string (reverse nm)) "."))
 	    (let* ((_module (in-scheme (resolve-module (reverse l))))
@@ -135,20 +135,18 @@
 	      (set self '_module _module)
 	      (hash-set! _modules l self))))))
       
-  (define __getattribute__
+  (define __getattr__
     (lambda (self k)
       (define (fail)
-	(raise (KeyError "getattr in Module")))
-      (aif it (rawref self k)
-           it
-           (if (rawref self '_module)
-               (let ((k (_k k))
-                     (m (_m self)))
-                 (let ((x (module-ref m k e)))
-                   (if (eq? e x)
-                       (fail)
-                       x)))
-               (fail)))))
+	(raise (AttributeError "getattr in Module")))
+      (if (rawref self '_module)
+	  (let ((k (_k k))
+		(m (_m self)))
+	    (let ((x (module-ref m k e)))
+	      (if (eq? e x)
+		  (fail)
+		  x)))
+	  (fail))))
 
   (define __setattr__
     (lambda (self k v)
@@ -175,13 +173,25 @@
 		(raise KeyError "delattr of missing key in Module")))
 	  (fail))))
 
+  (define __dir__
+    (lambda (self)
+      (let* ((h (slot-ref self 'h))
+	     (l '())
+	     (add (lambda (k . u) (set! l (cons (symbol->string k) l)))))
+	(hash-for-each add h)
+	(aif it (ref self '_module)
+	     (module-for-each add it)
+	     #f)
+	(py-list l))))
+	
+  
   (define __repr__
     (lambda (self) (format #f "Module(~a)" (ref self '__name__))))
 
   (define __getitem__
     (lambda (self k)
       (define k (if (string? k) (string->symbol k) k))
-      (__getattribute__ self k)))
+      (__getattr__ self k)))
   
   (define __iter__
     (lambda (self)
diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py
index 7e7e46c..eefc1b5 100644
--- a/modules/language/python/module/enum.py
+++ b/modules/language/python/module/enum.py
@@ -150,7 +150,7 @@ class EnumMeta(type):
         if invalid_names:
             raise ValueError('Invalid enum member name: {0}'.format(
                 ','.join(invalid_names)))
-
+        
         # create a default docstring if one has not been provided
         if '__doc__' not in classdict:
             classdict['__doc__'] = 'An enumeration.'
@@ -164,7 +164,7 @@ class EnumMeta(type):
 
         # save attributes from super classes so we know if we can take
         # the shortcut of storing members in the class dict
-
+        
         base_attributes = {a for b in enum_class.mro() for a in b.__dict__}
 
         # Reverse value->name map for hashable values.
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 86f2e2c..4d0b697 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -78,6 +78,9 @@ explicitly tell it to not update etc.
        it
        (error "IndexError")))
 
+(define-method (py-get x key . l)
+  (if (pair? l) (car l) #f))
+
 (define-method (py-get (o <hashtable>) key . l)
   (define -fail (if (pair? l) (car l) #f))
   (kif it (hash-ref o key fail)
@@ -121,6 +124,7 @@ explicitly tell it to not update etc.
 (define-method (rawset (o <procedure>) key val)
   (set-procedure-property! o key val))
 
+(define-method (find-in-class x key fail) fail)
 (define-method (find-in-class (klass <pf>) key fail)
   (let ((r (vhash-assoc key (slot-ref klass 'h))))
     (if r
@@ -130,7 +134,9 @@ explicitly tell it to not update etc.
 (define-method (find-in-class (klass <p>) key -fail)
   (let ((h (slot-ref klass 'h)))
     (aif dict (hash-ref h '__dict__)
-         (py-get dict key -fail)
+         (kif it (py-get dict key fail)
+	      it
+	      (hash-ref h key -fail))
          (hash-ref h key -fail))))
 
 
@@ -152,7 +158,7 @@ explicitly tell it to not update etc.
 (define (mk-getter-object f)
   (lambda (obj cls)
     (if (pytype? obj)
-	(lambda x (apply f x))
+	f
         (if (pyclass? obj)
             (if (pytype? cls)                
                 (lambda x (apply f obj x))
@@ -223,9 +229,10 @@ explicitly tell it to not update etc.
 
 
 (define (new-class0 meta name parents dict . kw)
-  (let* ((goops (pylist-ref dict '__goops__))
-	 (p     (kwclass->class kw meta))         
-	 (class (make-p p)))
+  (let* ((goops   (pylist-ref dict '__goops__))
+	 (p       (kwclass->class kw meta))
+	 (class   (make-p p)))
+    
     (slot-set! class 'procedure
 	       (lambda x
 		 (create-object class x)))
@@ -234,20 +241,31 @@ explicitly tell it to not update etc.
 	(hash-for-each
 	 (lambda (k v) k (set class k v))
 	 dict)
-        (set class '__dict__ dict))
+        (begin (set class '__dict__ dict)))
     
-    (let ((mro (ref class '__mro__)))
+    (let lp ((mro (find-in-class class '__mro__ #f)))
       (if (pair? mro)
 	  (let ((p (car mro)))
-	    (aif it (ref p '__zub_classes__)
+	    (aif it (find-in-class p '__zub_classes__ #f)
 		 (hash-set! it class #t)
 		 #f)
 	    
-	    (aif it (ref p '__init_subclass__)
+	    (aif it (find-in-class p '__init_subclass__ #f)
 		 (apply it class p #f kw)
-		 #f))))
+		 #f)
+	    
+	    (lp (cdr mro)))))
+    
     (set class '__mro__ (cons class (find-in-class-and-parents
 				     class '__mro__ '())))
+
+    (if (not (ficap class '__getattribute__ #f))
+	(set class '__getattribute__ attr))
+    (if (not (ficap class 'mro #f))
+	(set class 'mro _mro))
+
+    (set class '__class__ meta)
+    
     class))
 
 (define (new-class meta name parents dict kw)
@@ -264,12 +282,11 @@ explicitly tell it to not update etc.
 
 
 (define (the-create-object class x)
-  (let* ((meta  (ficap class '__class__ #f))
-         (goops (ficap class '__goops__ #f))
+  (let* ((meta  (and class (find-in-class class '__class__ #f)))
+         (goops (find-in-class class '__goops__ #f))
          (obj   (aif it (ficap class '__new__ #f)
                      (apply it class x)
                      (make-object class meta goops))))
-    
     (aif it (ficap class '__init__ #f)
          (apply it obj x)
          #f)
@@ -279,13 +296,13 @@ explicitly tell it to not update etc.
                  (aif it (ref obj '__call__)
                       (apply it x)
                       (error "not a callable object"))))
-
+    
     obj))
 
 (define (create-object class x)
   (if (pytype? class)
       (apply type-call class x)
-      (let ((meta (find-in-class class '__class__ #f)))
+      (let ((meta (and class (find-in-class class '__class__ #f))))
 	(with-fluids ((*make-class* #t))
 	  (aif it (ficap meta '__call__ #f)
 	       (apply it class x)
@@ -296,7 +313,7 @@ explicitly tell it to not update etc.
     (if (pytype? class)
         (apply (case-lambda
                  ((meta obj)
-                  (ref obj '__class__ 'None))
+                  (and obj (find-in-class obj '__class__ 'None)))
                  ((meta name bases dict . keys)
                   (type- meta name bases dict keys)))
                class l)
@@ -309,7 +326,7 @@ explicitly tell it to not update etc.
 
 (define (create-class meta name parents gen-methods keys)
   (let ((dict (gen-methods (get-dict meta name parents))))
-    (aif it (ref meta '__class__)
+    (aif it (and meta (find-in-class meta '__class__ #f))
          (aif it (find-in-class it '__call__ #f)
               (apply it meta name parents dict keys)
               (type- meta name parents dict keys))
@@ -398,7 +415,7 @@ explicitly tell it to not update etc.
     (fluid-set! *location* klass)
     (kif it (find-in-class-and-parents klass key fail)
 	 it
-	 (aif klass (find-in-class klass '__class__ #f)
+	 (aif klass (and klass (find-in-class klass '__class__ #f))
 	      (begin
 		(fluid-set! *location* klass)
 		(kif it (find-in-class-and-parents klass key fail)
@@ -411,13 +428,13 @@ explicitly tell it to not update etc.
 (define-inlinable (mrefx-py x key l)
   (let ((xx x))
     (let* ((f (aif it (mrefx xx '__getattribute__ '())
-                   (gox xx it)
+                   it
                    #f)))
-      (if (or (not f) (eq? f not-implemented))
+      (if (or (not f) (eq? f not-implemented))	  
           (gox xx (mrefx xx key l))
-	  (catch #t
-            (lambda () (f key))
-            (lambda z  (pk z) (if (pair? l) (car l) #f)))))))
+	  (kif it (f xx key)
+	       it
+	       (if (pair? l) (car l) #f))))))
 
 (define-syntax-rule (mref x key l)
   (let ((xx x))
@@ -524,7 +541,7 @@ explicitly tell it to not update etc.
 	        (lambda () (f key val))
 		(lambda q  (mset xx key val)))))
 	
-	(aif it (ref v '__class__)
+	(aif it (and v (find-in-class v '__class__ #f))
 	     (aif it (ref it '__set__)
 		  (it val)
 		  (mset xx key val))
@@ -780,7 +797,7 @@ explicitly tell it to not update etc.
     (define kw      (cdr s.kw))
     (define supers  (car s.kw))
     (define goopses (map (lambda (sups)
-			   (aif it (ref sups '__goops__ #f)
+			   (aif it (find-in-class sups '__goops__ #f)
 				it
 				sups))
 			 supers))
@@ -1114,19 +1131,20 @@ explicitly tell it to not update etc.
   (define (make cl parents)
     (if (not cl)
         #f
-        (if (or (pyclass? obj) (pytype? obj))
-            cl
-            (let ((c (make-p <py>))
-                  (o (make-p <py>)))
-              (set c '__class__        type)
-              (set c '__mro__          (cons c parents))
-              (set c '__getattribute__
-                   (object-method
-                    (lambda (self key . l)
-                      (ficap c key #f))))
-              (set c '__name__  "**super**")
-              (set o '__class__ c)
-              o))))
+        (let ((c (make-p <py>))
+	      (o (make-p <py>)))
+	  (set c '__class__        type)
+	  (set c '__mro__          (cons* c parents))
+	  (set c '__getattribute__
+	       (lambda (self key)
+		 (kif it (ficap c key fail)
+		      (aif dt (ref it '__get__)
+			   (dt obj cl)
+			   it)
+		      fail)))
+	  (set c '__name__  "**super**")
+	  (set o '__class__ c)
+	  o)))
   
   (call-with-values
       (lambda ()
@@ -1231,7 +1249,10 @@ explicitly tell it to not update etc.
 	  (up (car h) (cdr h))
 	  #f)))))
 
-(define (class-to-tree cl) (cons cl (map class-to-tree (ref cl '__bases__))))
+(define (class-to-tree cl)
+  (cons cl
+	(map class-to-tree
+	     (find-in-class cl '__bases__ #f))))
 
 (define (find-tree o tree)
   (if tree
@@ -1298,25 +1319,33 @@ explicitly tell it to not update etc.
 
 (define __getattribute__
   (case-lambda
-    ((self key)
-     (aif class (find-in-class self '__class__ #f)
-          (kif it1 (find-in-class-and-parents self key fail)
-               (aif dd1 (ref it1 '__get__)
-                    (if (ref it1 '__set__)
-                        (dd1 self class)
-                        (kif it2 (find-in-class self key fail)
-                             it2
-                             (it1 self class)))
-                    (kif it2 (find-in-class self key fail)
+   ((self key)
+    (define (-fail class)
+      (if (eq? key 'mro)
+	  (find-in-class self '__mro__ fail)
+	  fail))
+    
+    (aif class (find-in-class self '__class__ #f)
+	 (kif it1 (find-in-class-and-parents class key fail)
+	      (aif dd1 (rawref it1 '__get__)
+		   (if (rawref it1 '__set__)
+		       (dd1 self class)
+		       (kif it2 (find-in-class-and-parents self key fail)
+			    it2
+			    (dd1 self class)))
+                    (kif it2 (find-in-class-and-parents self key fail)
                          it2
                          it1))
-               (kif it2 (find-in-class self key fail)
-                    it2
-                    (aif it (ref self '__getattr__)
-                         (it key)
-                         (error "AttributeError" key))))
-          (error "AttributeError" "could not find class" key)))
-    (l (error "AttributeError" "wrong arguments BUG" l))))
+	      (kif it2 (find-in-class-and-parents self key fail)
+		   it2
+		   (aif it (find-in-class-and-parents class '__getattr__ #f)
+			(kif it1 (it self key)
+			     (aif dd1 (rawref it1 '__get__)
+				  (dd1 self class)
+				  it1)
+			     (-fail class))
+			(-fail class))))
+	 fail))))
              
 (define attr __getattribute__)
 
@@ -1331,12 +1360,15 @@ explicitly tell it to not update etc.
 
 (set type '__class__ type)
 
+(define _mro (object-method (lambda (self) (ref self '__mro__))))
+
 (set! object
   (make-python-class object ()
     (define __init__         (lambda x (values)))
     (define __subclasses__   subclasses)
-    (define __getattribute__ (object-method attr))
-    (define __weakref__      (lambda (self) self))))
+    (define __getattribute__ attr)
+    (define __weakref__      (lambda (self) self))
+    (define mro              _mro)))
                
 
 (name-object type)