improvements
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 25 Apr 2018 18:00:41 +0000 (20:00 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 25 Apr 2018 18:00:41 +0000 (20:00 +0200)
modules/language/python/compile.scm
modules/language/python/dict.scm
modules/language/python/for.scm
modules/language/python/list.scm
modules/language/python/module.scm
modules/language/python/module/enum.py
modules/language/python/module/python.scm
modules/oop/pf-objects.scm

index 93adc75a68b490138891b6e9e8dd2ab2a89f0b78..5df4f3c108e27f4bbf1f55ecc123e0d483508462 100644 (file)
                  (fluid-ref (@@ (system base message) %dont-warn-list)))))
     (lambda x (values))))
 
-(define *prefixes* (make-fluid '()))
-(define (add-prefix id)
-  (catch #t
-     (lambda ()
-       (if (fluid-ref (@@ (system base compile) %in-compile))
-          (fluid-set! *prefixes* (cons id (fluid-ref *prefixes*)))
-          (begin
-            (when (not (module-defined? (current-module) '__prefixes__))
-                  (module-define! (current-module)
-                                  '__prefixes__ (make-fluid '())))
-            
-            (let ((p (module-ref (current-module) '__prefixes__)))
-              (fluid-set! p (cons id (fluid-ref p)))))))
-     (lambda x (values))))
-
-(define (is-prefix? id)
-  (catch #t
-    (lambda ()
-      (if (fluid-ref (@@ (system base compile) %in-compile))
-         (member id (fluid-ref *prefixes*))
-         (if (not (module-defined? (current-module) '__prefixes__))
-             #f
-             (let ((p (module-ref (current-module) '__prefixes__)))
-               (member id (fluid-ref p))))))
-    (lambda x #f)))
-  
 (define-syntax call
   (syntax-rules ()
     ((_ (f) . l) (f . l))))
   (mkfast
    ;; General
    ((__init__)    (O 'py-init))
-   ((__getattr__) (O 'getattr))
-   ((__setattr__) (O 'setattr))
-   ((__delattr__) (O 'delattr))
+   ((__getattr__) (O 'ref))
+   ((__setattr__) (O 'set))
+   ((__delattr__) (O 'del))
    ((__ne__)      (O 'ne))
    ((__eq__)      (O 'equal?))
    ((__repr__)    (O 'repr))
                (lp (cdr l) (cons x r))))
         (list (G 'cons)  `(,(G 'list) ,@(reverse r)) ''()))))
 
-(define (get-addings vs x)
+(define (get-addings vs x fast?)
   (match x
     (() '())
     ((x . l)
            (let* ((tag     (exp vs x))
                   (xs      (gensym "xs"))
                   (fast    (fastfkn tag))
-                  (is-fkn? (aif it (and is-fkn? fast)
+                  (is-fkn? (aif it (and fast? is-fkn? fast)
                                 `(#:call-obj (lambda (e)
                                                (lambda ,xs
                                                  (apply ,it e ,xs))))
                                 #f)))
              (if is-fkn?
                  is-fkn?
-                 (if fast
+                 (if (and fast? fast)
                      `(#:fastfkn-ref ,fast ',tag)
-                     (aif it (fast-ref tag)
+                     (aif it (and fast? (fast-ref tag))
                           `(#:fast-id ,it ',tag)
                           `(#:identifier ',tag))))))
           
                       n1 n2 n3))))
         
           (_ (error "unhandled addings")))
-        (get-addings vs l))))))
+        (get-addings vs l fast?))))))
   
 (define-syntax-rule (setwrap u)
   (call-with-values (lambda () u)
     ((#:verb x) x)
     ((#:test (#:power kind v addings . _) . _)
      (let* ((v       (exp vs v))
-            (v.add   (if (is-prefix? v)
-                         (let ((w (symbol->string (exp vs (car addings)))))
-                           (cons (string-append (symbol->string v) "." w)
-                                 (cdr addings)))
-                         (cons v addings)))
-            (v       (car v.add))
-            (addings (cdr v.add))
-            (addings (get-addings vs addings))
+            (fast?   (not (eq? v 'super)))
+            (addings (get-addings vs addings fast?))
             (p.a     (match kind
                        (#f (cons #f '()))
                        ((v add)
-                        (if (is-prefix? v)
-                            (let ((w (symbol->string (exp vs (car add)))))
-                              (cons (string-append (symbol->string v) "." w)
-                                 (cdr add)))
-                            (cons (exp vs v) add)))))
+                        (cons (exp vs v) add))))
             (p      (car p.a))
             (pa     (cdr p.a))
-            (pa     (get-addings vs pa)))
+            (pa     (get-addings vs pa fast?)))
        (define q (lambda (x) `',x))
        (if kind
            (if (not p)
    (exp vs x))
   
   ((_ #f vf trailer . **)
-   (let* ((vf    (exp vs vf))
-          (vf.tr (if (is-prefix? vf)
-                     (cons
-                      (string->symbol
-                       (string-append
-                        (symbol->string vf)
-                        "."
-                        (symbol->string (exp vs (car trailer)))))
-                      (cdr trailer))
-                     (cons vf trailer)))
-          (vf      (car vf.tr))
-          (trailer (cdr vf.tr)))
+   (let* ((vf      (exp vs vf))
+          (fast?   (not (eq? vf 'super))))
      (define (pw x)
        (if **
            `(expt ,x ,(exp vs **))
            x))
      (pw
-      (let ((trailer (get-addings vs trailer)))
+      (let ((trailer (get-addings vs trailer fast?)))
         `(,(C 'ref-x) ,vf ,@trailer))))))
  
  (#:identifier
    '(void))
   
   ((_  (#:power #f base (l ... fin) . #f))
-   (let ((add (get-addings vs l))
-         (fin (get-addings vs (list fin)))
-         (f   (exp vs base)))     
+   (let* ((f     (exp vs base))
+          (fast? (not (eq? f 'super)))
+          (add   (get-addings vs l fast?))
+          (fin   (get-addings vs (list fin) fast?)))
+         
      `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin))))
 
  (#:with
                           (() #f)
                           (#f #f)
                           ((#:arglist . _)
-                           (get-addings vs (list parents))))))
+                           (get-addings vs (list parents) #f)))))
           `(set! ,class
              (,(C 'class-decor) ,decor
               (,(C 'with-class) ,class
       (x '())))
   
   (if (fluid-ref (@@ (system base compile) %in-compile))
-      (with-fluids ((*prefixes* '()))             
+      (begin
         (if (fluid-ref (@@ (system base compile) %in-compile))
             (set! s/d 'set!)
             (set! s/d (C 'define-)))
index f76e2ad019fb3d1700fd6b809bef83b7e18c8cea..0e130d004142116e699a14e09f209d72434c01d8 100644 (file)
    0 o))
 
 (define-method (py-hash (o <py-hashtable>))
-  (slot-ref o 'h))
+  (slot-ref o 'hash))
 
 (define-method (len (o <hashtable>))
   (hash-fold (lambda (k v s) (+ s 1)) 0 o))
 (define-method (in key (o <py-hashtable>))
   (py-has_key o key))
 
+
+(define <dict> `(,<py-hashtable> . _))
+(define dict-set!   (resolve-method-g pylist-set!    <dict>))
+(define dict-ref    (resolve-method-g pylist-ref     <dict>))
+(define dict-del!   (resolve-method-g pylist-delete! <dict>))
+(define dict-pop!   (resolve-method-g pylist-pop!    <dict>))
+(define dict-clear! (resolve-method-g py-clear       <dict>))
+(define dict-get    (resolve-method-g py-get         <dict>))
+(define dict-len    (resolve-method-g len            <dict>))
+(define dict-bool   (resolve-method-g bool           <dict>))
+
+
 (define-python-class dict (<py-hashtable>)
+  (define __getitem__  dict-ref)
+  (define __setitem__  dict-set!)
+  (define __delitem__  dict-del!)
+  (define pop          dict-pop!)
+  (define clear        dict-clear!)
+  (define get          dict-get)
+  (define __len__      dict-len)
+  (define __bool__     dict-bool)
+  (define __format___  (lambda x #f))
+  (define __setattr__      (@@ (oop pf-objects) __setattr__))
+  (define __getattribute__ (@@ (oop pf-objects) __getattribute__))
+   
   (define __init__
     (letrec ((__init__
               (case-lambda
index 7b8e57bc8cb9e13e79ac1c72c0e2a18dcc63f52d..c618828be6d15838d9ecb742f3bd6de0dfdd62a7 100644 (file)
                       (slot-ref o 's)
                       (slot-ref o 'i))))
 
+(define-method (next x)
+  (throw StopIteration))
+
 (define-method (next (l <scm-list>))
   (let ((ll (slot-ref l 'l)))
     (if (pair? ll)
index ddb4be5cfc86a998fe4b426c7ee3a484b57fbe56..1a8374eddc8568b270bcd5e0885817cd9da71352 100644 (file)
   (define N (string-length o))
   (define (f n) (if (< n 0) (+ N n) n))
     
-  (let* ((n1   (f (if (eq? n1 None) 0                n1)))
-         (n2   (f (if (eq? n2 None) (slot-ref o 'n)  n2)))
-         (n3   (f (if (eq? n3 None) 1                n3))))
+  (let* ((n1   (f (if (eq? n1 None) 0                  n1)))
+         (n2   (f (if (eq? n2 None) (string-length o)  n2)))
+         (n3   (f (if (eq? n3 None) 1                  n3))))
     (list->string
      (to-list
       (pylist-slice (to-pylist o) n1 n2 n3)))))
        #:final
        #t))
 
-(define (py-any x)
+(define (py-any x)
   (for ((i : x)) ()
        (if i
            (break #t))
index 5c5d630354a3f357373510ecf7fc8af1dcba81fe..657045215b213a19bbb6483e2543a1318c57c7f3 100644 (file)
      ((self pre l nm)
       (match l
        ((name)
-       (set self '_path (reverse (cons name pre)))           
+       (rawset self '_path (reverse (cons name pre)))        
        (_cont self #f   (cons name pre) #f (cons name nm) #f))
        
        ((name . (and l (name2 . _)))
-       (set self '_path (reverse (cons name pre)))
+       (rawset self '_path (reverse (cons name pre)))
        (_cont self name2 (cons name pre) l  (cons name nm) #t))))
        
 
       (rawset self '_private #f)
       (if (not (rawref self '_module))
          (begin
-           (set self '__name__ (string-join
-                                (map symbol->string (reverse nm)) "."))
+           (rawset self '__name__ (string-join
+                                    (map symbol->string (reverse nm)) "."))
            (let* ((_module (in-scheme (resolve-module (reverse l))))
                    (public-i (and _module (module-public-interface _module))))
               (if (and (not skip-error?) (not public-i))
                           (format #f "No module named ~a"
                                   (ref self '__name__)))))
               
-             (set self '_export (module-public-interface _module))
-             (set self '_module _module)
+             (rawset self '_export (module-public-interface _module))
+             (rawset self '_module _module)
              (hash-set! _modules l self))))))
       
   (define __getattr__
     (lambda (self)
       (let* ((h (slot-ref self 'h))
             (l '())
+             (m (_m self))
             (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)
+        (module-for-each add m)
        (py-list l))))
        
   
index eefc1b50bf3a024910e52560a77ad9a6f98cc477..0f623f05be0b2fb572a97c6bb6ba9cd7d045ee28 100644 (file)
@@ -83,7 +83,7 @@ class _EnumDict(dict):
             if key not in (
                     '_order_', '_create_pseudo_member_',
                     '_generate_next_value_', '_missing_',
-                    ):
+                          ):
                 raise ValueError('_names_ are reserved for future Enum use')
             if key == '_generate_next_value_':
                 setattr(self, '_generate_next_value', value)
@@ -118,7 +118,7 @@ class EnumMeta(type):
     def __prepare__(metacls, cls, bases):
         # create the namespace dict
         enum_dict = _EnumDict()
-        
+
         # inherit previous flags and _generate_next_value_ function
         member_type, first_enum = metacls._get_mixins_(bases)
 
@@ -157,14 +157,14 @@ class EnumMeta(type):
 
         # create our new Enum type
         enum_class = super().__new__(metacls, cls, bases, classdict)
-        
+        pk(enum_class)
         enum_class._member_names_ = []               # names in definition order
         enum_class._member_map_ = OrderedDict()      # name->value map
         enum_class._member_type_ = member_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.
@@ -261,7 +261,7 @@ class EnumMeta(type):
                 _order_ = _order_.replace(',', ' ').split()
             if _order_ != enum_class._member_names_:
                 raise TypeError('member order does not match _order_')
-        pk('enum class fom new',enum_class)
+
         return enum_class
 
     def __bool__(self):
@@ -364,11 +364,17 @@ class EnumMeta(type):
         resulting in an inconsistent Enumeration.
 
         """
+        
         member_map = cls.__dict__.get('_member_map_', {})
+        
         if name in member_map:
             raise AttributeError('Cannot reassign members.')
+        
+        pk('set',name)
+        
         super().__setattr__(name, value)
 
+
     def _create_(cls, class_name, names=None, *, module=None, qualname=None, type=None, start=1):
         """Convenience method to create a new Enum class.
 
@@ -516,13 +522,15 @@ class EnumMeta(type):
 
         return __new__, save_new, use_args
 
-pk(1)
+
 class Enum(metaclass=EnumMeta):
     """Generic enumeration.
 
     Derive from this class to define new enumerations.
 
     """
+    pk(1)
+    
     def __new__(cls, value):
         # all enum instances are actually created during class construction
         # without calling this method; this method is called by the metaclass'
@@ -543,6 +551,8 @@ class Enum(metaclass=EnumMeta):
         # still not found -- try _missing_ hook
         return cls._missing_(value)
 
+    pk(2)
+    
     def _generate_next_value_(name, start, count, last_values):
         for last_value in reversed(last_values):
             try:
@@ -552,6 +562,8 @@ class Enum(metaclass=EnumMeta):
         else:
             return start
 
+    pk(3)
+    
     @classmethod
     def _missing_(cls, value):
         raise ValueError("%r is not a valid %s" % (value, cls.__name__))
@@ -571,7 +583,7 @@ class Enum(metaclass=EnumMeta):
                 if m[0] != '_' and m not in self._member_map_
                 ]
         return (['__class__', '__doc__', '__module__'] + added_behavior)
-
+    pk(4)
     def __format__(self, format_spec):
         # mixed-in Enums should use the mixed-in type's __format__, otherwise
         # we can get strange results with the Enum name showing up instead of
@@ -599,7 +611,7 @@ class Enum(metaclass=EnumMeta):
     # to have members named `name` and `value`.  This works because enumeration
     # members are not set directly on the enum class -- __getattr__ is
     # used to look them up.
-
+    pk(5)
     @DynamicClassAttribute
     def name(self):
         """The name of the Enum member."""
@@ -646,7 +658,6 @@ class Enum(metaclass=EnumMeta):
         module_globals[name] = cls
         return cls
 
-pk(2)
 
 class IntEnum(int, Enum):
     """Enum where members are also (and must be) ints"""
@@ -763,7 +774,6 @@ class Flag(Enum):
         inverted = reduce(_or_, inverted_members, self.__class__(0))
         return self.__class__(inverted)
 
-
 class IntFlag(int, Flag):
     """Support for integer-based Flags"""
 
@@ -828,7 +838,6 @@ class IntFlag(int, Flag):
         result = self.__class__(~self._value_)
         return result
 
-
 def _high_bit(value):
     """returns index of highest bit, or -1 if value is zero or negative"""
     return value.bit_length() - 1
index ef42cc6a63ec00612376a2574c8773ac80e66b48..1a907578f71dc4bfb8eeb57e4243c65a48bd5f7d 100644 (file)
@@ -3,9 +3,9 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 readline)
   #:use-module ((oop pf-objects) #:select
-                (<p> <property> class-method static-method ref
+                (<p> <property> class-method static-method ref (set . pf-set)
                      py-super-mac type object pylist-ref define-python-class
-                    object-method))
+                    object-method py-dict))
   #:use-module (language python exceptions       )
   #:use-module ((language python module string   ) #:select ())
   #:use-module ((language python module io       ) #:select (open))
                   divmod enumerate filter
                   getattr hasattr setattr hex isinstance issubclass
                   iter sum id input oct ord pow super
-                  sorted zip
+                  sorted zip vars
                  ClassMethod StaticMethod Funcobj))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+(define vars py-dict)
+
 (define print
   (case-lambda
     (()  ((@ (guile) format) #t "~%"))
         r)))
 
 (define (setattr a k v)
-  (set a (if (string? k) (string->symbol k) k) v))
+  (pf-set a (if (string? k) (string->symbol k) k) v))
 
 (define (hasattr a b)
-  (let ((r (ref a (symbol->string b) miss)))
+  (let ((r (ref a (if (string? b) (string->symbol b) b) miss)))
     (not (eq? r miss))))
 
 (define-method (issubclass x y) #f)
index 4d0b697686c165cb4dbdca6e856b773a6a6a7a3b..6ee2c58f18d31812e02a36b63e679a2c64d810d9 100644 (file)
@@ -34,19 +34,30 @@ The datastructure is functional but the objects mutate. So one need to
 explicitly tell it to not update etc.
 |#
 
+#;
+(define (pkk . l)
+  (let* ((r (reverse l))
+         (x (reverse (cdr r)))
+         (z (car r)))
+    (apply pk x)
+    z))
+(define (pkk . l)
+  (car (reverse l)))
+
+
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define (pk-obj o)
   (pk 'start-pk-obj)
   (let ((h (slot-ref o 'h)))
     (hash-for-each (lambda (k v)
-                    (if (member k '(__name__ __qualname__))
+                    (if (member k '(__name__ __qualname__ __class__))
                         (pk k v)
                         (pk k))) h)
     
     (pk 'finished-obj)
     
-    (let lp ((l (ref o '__mro__ '())))
+    (let lp ((l (pk 'mro (ref o '__mro__ '()))))
       (if (pair? l)
          (let ((cl (car l)))
            (if (is-a? cl <p>)
@@ -139,7 +150,6 @@ explicitly tell it to not update etc.
              (hash-ref h key -fail))
          (hash-ref h key -fail))))
 
-
 (define-syntax-rule (find-in-class-and-parents klass key fail-)
   (aif parents (find-in-class klass '__mro__ #f)
        (let lp ((parents parents))
@@ -157,13 +167,15 @@ explicitly tell it to not update etc.
 
 (define (mk-getter-object f)
   (lambda (obj cls)
-    (if (pytype? obj)
+    (pkk 'obj-name (find-in-class obj '__name__ #f))
+    (pkk 'cls-name (find-in-class cls '__name__ #f))
+    (if (pkk 'type-obj (pytype? obj))
        f
-        (if (pyclass? obj)
-            (if (pytype? cls)                
+        (if (pkk 'class-obj (pyclass? obj))
+            (if (pkk 'type-cls (pytype? cls))
                 (lambda x (apply f obj x))
                 f)
-            (if (pyclass? cls)
+            (if (pkk 'class-cls (pyclass? cls))
                 (lambda x (apply f obj x))
                 f)))))
 
@@ -227,9 +239,28 @@ explicitly tell it to not update etc.
   
 (define (hashforeach a b) (values))
 
-
+(define (add-default c l)
+  (if (pair? l)
+      (let ((l (let ((y (car l))) (if (eq? y c) l (cons c l)))))        
+        (let* ((r (reverse l))
+               (x (car r)))
+          (if x
+              (if (or (not type) (pytype? x))
+                  (if (or (not type) (eq? x type))
+                      l
+                      (reverse (cons type r)))
+                  (if (or (not object) (eq? x object))
+                      l
+                      (reverse (cons object r))))
+              l)))
+      (if object
+          (if (pytype? c)
+              (list c type)
+              (list c object))
+         (cons c l))))
+        
 (define (new-class0 meta name parents dict . kw)
-  (let* ((goops   (pylist-ref dict '__goops__))
+  (let* ((goops   (pkk 'new-class0 name (pylist-ref dict '__goops__)))
         (p       (kwclass->class kw meta))
         (class   (make-p p)))
     
@@ -255,16 +286,37 @@ explicitly tell it to not update etc.
                 #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))
+    (when class
+      (rawset class '__class__ meta)
+      (rawset class '__goops__ goops)
+      (rawset class '__name__  (pylist-ref dict '__name__))
+      (rawset class '__bases__ (pylist-ref dict '__bases__))
+
+      (rawset class '__mro__
+              (add-default
+               class
+               (find-in-class-and-parents
+                class '__mro__ '())))
 
-    (set class '__class__ meta)
+      (if (not (ficap class '__getattribute__ #f))
+          (rawset class '__getattribute__ attr))
+
+      (aif it (py-get dict '__getattribute__ #f)
+           (rawset class '__getattribute__ it)
+           #f)
+        
+      (aif it (py-get dict '__getattr__)
+           (rawset class '__getattr__ it)
+           #f)
+        
+      (aif it (py-get dict '__setattr__ #f)
+           (rawset class '__setattr__ it)
+           #f)
+      
+      (aif it (py-get dict '__delattr__ #f)
+           (rawset class '__delattr__ it)
+           #f))
     
     class))
 
@@ -287,6 +339,7 @@ explicitly tell it to not update etc.
          (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)
@@ -334,7 +387,7 @@ explicitly tell it to not update etc.
 
 (define (make-object class meta goops)
   (let ((obj (make-p goops)))
-    (set obj '__class__ class)
+    (rawset obj '__class__ class)
     obj))
 
 ;; Make an empty pf object
@@ -425,16 +478,24 @@ explicitly tell it to not update etc.
 
 (define not-implemented (cons 'not 'implemeneted))
 
-(define-inlinable (mrefx-py x key l)
+(define (mrefx-py x key l)
   (let ((xx x))
-    (let* ((f (aif it (mrefx xx '__getattribute__ '())
+    (define (exit) (if (pair? l) (car l) #f))
+    (aif class (find-in-class xx '__class__ #f)
+         (aif f (find-in-class-and-parents class '__getattribute__ #f)
+              (kif it (if (eq? f __getattribute__)
+                          (f xx key)
+                          (catch #t
+                            (lambda ()
+                              (f xx (symbol->string key)))
+                            (lambda q fail)))
+                              
                    it
-                   #f)))
-      (if (or (not f) (eq? f not-implemented))   
-          (gox xx (mrefx xx key l))
-         (kif it (f xx key)
-              it
-              (if (pair? l) (car l) #f))))))
+                   (exit))
+              (kif it (__getattribute__ xx key)
+                   it
+                   (exit)))
+         #f)))
 
 (define-syntax-rule (mref x key l)
   (let ((xx x))
@@ -518,34 +579,23 @@ explicitly tell it to not update etc.
 (define *make-class* (make-fluid #f))
 (define (mc?) (not (fluid-ref *make-class*)))
 
-(define-syntax-rule (mset-py x key val)
-  (let* ((xx x)
-        (v  (mref xx key (list fail))))
-    (if (eq? v fail)
-       (let* ((g (mrefx xx '__fset__ '(#t)))
-              (f (if g
-                     (if (eq? g #t)
-                         (aif it (rawref xx '__setattr__)
-                              (begin
-                                (rawset xx '__fset__ it)
-                                it)
-                              (begin
-                                (if (mc?)
-                                    (rawset xx '__fset__ it))
-                                #f))
-                         g)
-                     #f)))
-         (if (or (eq? f not-implemented) (not f))
-             (mset xx key val)              
-             (catch #t
-               (lambda () (f key val))
-               (lambda q  (mset xx key val)))))
-       
-       (aif it (and v (find-in-class v '__class__ #f))
-            (aif it (ref it '__set__)
-                 (it val)
-                 (mset xx key val))
-            (mset xx key val)))))
+(define __setattr__
+  (lambda (self key val)
+    (kif desc (ref self key fail)
+         (aif it (ref desc '__set__)
+              (it self val)
+              (mset self key val))
+         (mset self key val))))
+
+(define (mset-py x key val)
+  (let* ((xx x))
+    (aif class (find-in-class xx '__class__ #f)
+         (aif f (find-in-class-and-parents class '__setattr__ #f)
+              (if (eq? f __setattr__)
+                  (f            xx key val)
+                  (f            xx (symbol->string key) val))
+              (__setattr__  xx key val))
+         (mset xx key val))))
 
 (define-syntax-rule (mklam (mset a ...) val)
   (mset a ... val))
@@ -862,8 +912,9 @@ explicitly tell it to not update etc.
                     (cons y (lp (cdr x)))
                     (lp (cdr x))))
               '())))
-      
+
       (methods dict)
+
       (pylist-set! dict '__goops__    goops)
       (pylist-set! dict '__class__    meta)
       (pylist-set! dict '__zub_classes__ (make-weak-key-hash-table))
@@ -996,7 +1047,8 @@ explicitly tell it to not update etc.
                             (make-p-class 'name doc
                                           parents
                                           (lambda (dict)
-                                            (pylist-set! dict 'dname dname)
+                                             (begin
+                                               (pylist-set! dict 'dname dname))
                                             ...
                                             (values)))))
                        (begin
@@ -1129,36 +1181,41 @@ explicitly tell it to not update etc.
 (define (not-a-super) 'not-a-super)
 (define (py-super class obj)
   (define (make cl parents)
+    (pk 'parents cl parents)
     (if (not cl)
         #f
         (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)
+         (rawset c '__class__        type)
+         (rawset c '__mro__          (cons* c parents))
+         (rawset c '__getattribute__
+                  (lambda (self key)
+                    (set! key (if (string? key) (string->symbol key) key))
+                    (pk 'key key)
+                    (pk key (kif it (pk 'it (ficap c key fail))
+                                 (aif dt (pk '__get__ (ref it '__get__))
+                                      (dt obj cl)
+                                      it)
+                                 fail))))
+         (rawset c '__name__  "**super**")
+         (rawset o '__class__ c)
          o)))
-  
+
+  (pk 'super class (ref obj '__name__))
+
   (call-with-values
       (lambda ()
-        (let lp ((l (ref (if (or (pytype? obj) (pyclass? obj))
-                            obj
-                            (ref obj '__class__))
-                        '__mro__ '())))
-          (if (pair? l)
-              (if (eq? class (car l))
-                  (let ((r (cdr l)))
-                    (if (pair? r)
-                        (values (car r) r)
-                        (values #f      #f)))
-                  (lp (cdr l)))
+        (let ((ll (pk 'l class (ref (ref obj '__class__) '__mro__ '()))))
+          (if (pair? ll)
+              (let lp ((l ll))
+                (if (pair? l)
+                    (if (eq? class (car l))
+                        (let ((r (cdr l)))
+                          (if (pair? r)
+                              (values (car r) r)
+                              (values #f      #f)))
+                        (lp (cdr l)))
+                    (values (car ll) ll)))
               (values #f #f))))
     make))
         
@@ -1201,9 +1258,13 @@ explicitly tell it to not update etc.
                         
 
              
-       
+(define-method (py-init . l)
+  (values))
+
 (define-method (py-init (o <p>) . l)
-  (apply (ref o '__init__) l))
+  (aif it (ref o '__init__)
+       (apply it l)
+       (next-method)))
 
 (define mk-tree
   (case-lambda
@@ -1252,7 +1313,7 @@ explicitly tell it to not update etc.
 (define (class-to-tree cl)
   (cons cl
        (map class-to-tree
-            (find-in-class cl '__bases__ #f))))
+            (ref cl '__bases__ '()))))
 
 (define (find-tree o tree)
   (if tree
@@ -1317,6 +1378,7 @@ explicitly tell it to not update etc.
         (hash-fold (lambda (k v s) (cons k s)) '() h))
        '()))
 
+
 (define __getattribute__
   (case-lambda
    ((self key)
@@ -1325,30 +1387,38 @@ explicitly tell it to not update etc.
          (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)
+    (aif class (pkk 'class (find-in-class self '__class__ #f))
+        (kif it1 (pkk 'c (find-in-class-and-parents class key fail))
+             (aif dd1 (pkk 'get (rawref it1 '__get__))
+                  (if (pkk 'set (rawref it1 '__set__))
+                      (pkk 'desc key (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-and-parents self key fail)
-                  it2
-                  (aif it (find-in-class-and-parents class '__getattr__ #f)
-                       (kif it1 (it self key)
+                           (pkk 'object key it2)
+                           (pkk 'gox    key (dd1 self class))))
+                    (kif it2 (pkk 'o (find-in-class-and-parents self key fail))
+                         (pkk 'object key it2)
+                         (pkk 'class  key it1)))
+             (kif it2 (pkk 'o2 (find-in-class-and-parents self key fail))
+                  (pkk 'object key it2)
+                  (aif it (pkk 'getattr
+                                (find-in-class-and-parents class '__getattr__ #f))
+                       (kif it1 (catch #t
+                                   (lambda () (it self (symbol->string key)))
+                                   (lambda x fail))
                             (aif dd1 (rawref it1 '__get__)
-                                 (dd1 self class)
-                                 it1)
-                            (-fail class))
-                       (-fail class))))
-        fail))))
+                                 (pkk 'getattr-gox key (dd1 self class))
+                                 (pkk 'getattr     key it1))
+                            (pkk 'fail1 (-fail class)))
+                       (pkk 'fail2 (-fail class)))))
+        (pkk 'classfail fail)))))
              
 (define attr __getattribute__)
 
+(define (*str* self)
+  (scmstr (ref self '__name__)))
+
+(define *setattr* __setattr__)
+
 (set! type
   (make-python-class type ()
      (define __new__           new-class0)
@@ -1356,19 +1426,29 @@ explicitly tell it to not update etc.
      (define ___zub_classes__  (make-weak-key-hash-table))
      (define __subclasses__    subclasses)
      (define __call__          type-call)
+     (define __str__           *str*)
+     (define __getattribute__  attr)
+     (define __setattr__       (object-method *setattr*))
+     (define __format__        (lambda (self x) (*str* self)))
+     (define __reduce_ex__     (lambda x (error "not implemented")))
      (define mro               (lambda (self) (ref self '__mro__)))))
 
 (set type '__class__ type)
 
 (define _mro (object-method (lambda (self) (ref self '__mro__))))
 
+(define (scmstr s) (if (symbol? s) (symbol->string s) s))
+
 (set! object
   (make-python-class object ()
     (define __init__         (lambda x (values)))
     (define __subclasses__   subclasses)
     (define __getattribute__ attr)
-    (define __weakref__      (lambda (self) self))
-    (define mro              _mro)))
+    (define __setattr__      (object-method *setattr*))
+    (define __str__          *str*)
+    (define __format__        (lambda (self x) (*str* self)))
+    (define __reduce_ex__     (lambda x (error "not implemented")))
+    (define __weakref__      (lambda (self) self))))
                
 
 (name-object type)
@@ -1379,13 +1459,16 @@ explicitly tell it to not update etc.
        it
        (next-method)))
 
+(define-python-class NoneObj ()
+  (define __new__
+    (lambda x 'None)))
 
+(define-method (py-dict x)
+  (if (eq? x 'None)
+      (py-dict NoneObj)
+      (make-hash-table)))
+      
 (define-method (py-dict (o <p>))
   (aif it (ref o '__dict__)
        it
        (slot-ref o 'h)))
-
-(define-python-class NoneObj ()
-  (define __new__
-    (lambda x 'None)))
-