abc

9 files changed, 299 insertions, 116 deletions

diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index 6f5e381..a234281 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -19,6 +19,8 @@
             py-hash-ref dict pyhash-listing
 	    weak-key-dict weak-value-dict
 	    py-hash-ref py-hash-set!
+	    make-py-weak-key-hashtable
+	    make-py-weak-value-hashtable
             ))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 0b91293..b12f89b 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -6,7 +6,8 @@
                           IndexError KeyError AttributeError
                           SyntaxError SystemException
                           OSError ProcessLookupError PermissionError
-                          None NotImplemented NotImplementedError))
+                          None NotImplemented NotImplementedError
+			  RunTimeError))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -25,6 +26,7 @@
 (define ProcessLookupError  'ProcessLookupError)
 (define PermissionError     'PermissionError)
 (define NotImplementedError 'NotImplementedError)
+(define RunTimeError        'RunTimeError)
 
 (define-python-class Exception ()
   (define __init__
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index bf37bad..50e6ec4 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -52,6 +52,7 @@
                      (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      ((N ...)        (map length #'((x ...) ...)))
+		     (M              (length #'(c ...)))
                      (else-          (datum->syntax #'for 'else-))
                      (llp            (if (syntax->datum #'lp) #'lp #'lpu)))
          
@@ -75,7 +76,7 @@
                        (call-with-values
                            (lambda () (next It))
                          (let ((f
-                                (lambda (x2 ...)
+                                (lambda (x2 ... . ll)
                                   (set! x1 x2) ...)))
                            (if (> N 1)
                                (case-lambda
@@ -96,7 +97,7 @@
                            #,(wrap-continue
 			      #'lp
 			      #'((let ((x x) ... ...) code ...)))
-                         (lambda (cc ... . q) (llp cc ...)))))
+			 (lambda (cc ... . q) (llp cc ...)))))
                    (lambda q (else-) fin)))))))))))
 
 (define-class <scm-list>   () l)
diff --git a/modules/language/python/module/abc.scm b/modules/language/python/module/abc.scm
new file mode 100644
index 0000000..f0b8442
--- /dev/null
+++ b/modules/language/python/module/abc.scm
@@ -0,0 +1,167 @@
+(define-module (language python module abc)
+  #:use-module (language python module weakref)
+  #:use-module (oop pf-objects)
+  #:use-module (ice-9 control)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python dict)
+  #:use-module (language python set)
+  #:use-module (language python string)
+  #:use-module (language python list)
+  #:use-module (language python def)
+  #:use-module (language python bool)
+  #:use-module (language python exceptions)
+  #:use-module (language python property)
+  #:use-module ((language python module python)
+		#:select (objectmethod classmethod staticmethod type
+				       isinstance super issubclass
+				       getattr sorted dir))
+  
+  #:export (get_cache_token ABC ABCMeta
+			    abstractmethod abstractclassmethod
+			    abstractstaticmethod abstractproperty
+			    get_cache_token))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define (abstractmethod f)
+  (set f '__isabstractmethod__ #t)
+  (objectmethod f))
+
+
+(define (abstractclassmethod f)
+  (set f '__isabstractmethod__ #t)
+  (classmethod f))
+
+(define (abstractstaticmethod f)
+  (set f '__isabstractmethod__ #t)
+  f)
+
+(define (abstractproperty f)
+  (let ((f (property f)))
+    (set f '__isabstractmethod__ #t)
+    f))
+  
+(define-python-class ABCMeta (type)
+  (define _abc_invalidation_counter 0)
+
+  (define __new__
+    (lam (mcls name bases namespace (** kwargs))
+	 (let ((cls (py-apply (ref (super *class* mcls) '__new__)
+			      mcls name bases namespace (** kwargs)))
+	       
+	       (abstracts
+		(py-set
+		 (append (list name)
+			 (for ((name value : (py-items namespace))) ((l '()))
+			      (if (ref value '__isabstractmethod__)
+				  (cons name l)
+				  l)
+			      #:final (reverse l))))))
+
+	   (for ((base : bases)) ()
+		(for ((name : (ref base '__abstractmethods__ (py-set '())))) ()
+		     (let ((value (getattr cls name None)))
+		       (if (ref value '__isabstractmethod__)
+			   ((ref abstracts 'add) name)))))
+
+	   (set cls '__abstractmethods__ (frozenset abstracts))
+	   (set cls '_abc_registry       (WeakSet))
+	   (set cls '_abc_cache          (WeakSet))
+	   (set cls '_abc_negative_cache (WeakSet))
+	   (set cls '_abc_negative_cache_version _abc_invalidation_counter)
+
+	   cls)))
+  
+  (define register
+    (lambda (cls subclass)
+      (if (not (isinstance subclass type))
+	  (raise TypeError "Can only register classes"))
+      
+      (if (issubclass subclass cls)
+	  subclass
+	  (if (issubclass cls subclass)
+	      (raise RuntimeError "Refusing to create an inheritance cycle")
+	      (begin
+		((ref (ref cls '_abc_registry) 'add) subclass)
+		(set ABCMeta '_abc_invalidation_counter
+		     (+ (ref ABCMeta '_abc_invalidation_counter) 1))
+		subclass)))))
+
+  (define _dump_registry
+    (lam (cls (= file None))
+      (define port (if (eq? file None) #t file))
+      (format port "Class: ~a.~a~%"
+	      (ref cls '__module__) (ref cls '__name__))
+      (format port "Inv.counter: ~a~%" (ref ABCMeta '_abc_invalidation_counter))
+      (for ((name : (sorted (dir cls)))) ()
+	   (if (py-startswith name "_abc_")
+	       (let ((value (getattr cls name)))
+		 (format port "~a: ~a~%" name value))))))
+
+  (define __instancecheck__
+    (lambda (cls instance)
+      (let ((subclass (ref instance '__class__)))
+        (if (in subclass (ref cls '_abc_cache))
+            #t
+	    (let ((subtype (type instance)))
+	      (if (eq? subtype subclass)
+		  (if (and (= (ref cls '_abc_negative_cache_version)
+			      (ref ABCMeta '_abc_invalidation_counter))
+			   (in subclass (ref cls '_abc_negative_cache)))
+		      #f
+		      ((ref cls '__subclasscheck__) subclass))
+		  (or ((ref cls '__subclasscheck__) subclass)
+		      ((ref cls '__subclasscheck__) subtype))))))))
+
+  (define __subclasscheck__
+    (lambda (cls subclass)
+      (let/ec ret
+	(cond
+	 ((in subclass (ref cls '_abc_cache))
+	  (ret #t))
+	 ((< (ref cls '_abc_negative_cache_version)
+	     (ref ABCMeta '_abc_invalidation_counter))
+
+	  (set cls '_abc_negative_cache (WeakSet))
+	  (set cls '_abc_negative_cache_version
+	       (ref ABCMeta '_abc_invalidation_counter)))
+	 ((in subclass (ref cls '_abc_negative_cache))
+	  (ret #f)))
+
+	(aif it (ref cls '__subclasshook__)
+	     (let ((ok (it subclass)))
+	       (if (not (eq? ok NotImplemented))
+		   (begin
+		     (if (bool ok)
+			 ((ref (ref cls '_abc_cache) 'add) subclass)
+			 ((ref (ref cls '_abc_negative_cache) 'add) subclass)))
+		   (ret (bool ok))))
+	     #f)
+	
+        
+        (if (in cls (ref subclass '__mro__ '()))
+            (begin
+	      ((ref (ref cls '_abc_cache) 'add) subclass)
+	      (ret #t)))
+
+	(for ((rcls : (ref cls '_abc_registry))) ()
+	     (when (issubclass subclass rcls)
+		   ((ref (ref cls '_abc_cache) 'add) subclass)
+		   (ret #t)))
+
+	(aif it (ref cls '__subclasses__)
+	     (for ((scls : (it))) ()
+		  (when (issubclass subclass scls)
+			((ref (ref cls '_abc_cache) 'add) subclass)
+			(ret #t)))
+	     #f)
+
+	((ref (ref cls '_abc_negative_cache) 'add) subclass)
+	#f))))
+
+(define-python-class ABC (#:metaclass ABCMeta))
+
+
+(define (get_cache_token)
+   (ref ABCMeta '_abc_invalidation_counter))
diff --git a/modules/language/python/module/functools.scm b/modules/language/python/module/functools.scm
index 5f2bd5e..e2a5ce1 100644
--- a/modules/language/python/module/functools.scm
+++ b/modules/language/python/module/functools.scm
@@ -9,7 +9,8 @@
   #:use-module (language python module collections)
   #:use-module ((language python module python)
 		#:select (iter getattr setattr repr isinstance callable
-			       bool str int))
+			       bool str int enumerate reversed hasattr
+			       issubclass any))
   #:use-module (language python list)
   #:use-module (language python dict)
   #:use-module (language python set)
@@ -509,13 +510,13 @@
     (set wrapper 'cache_clear cache_clear)
     wrapper))
 
-#|
+
 ;; single dispatch
 (define (_c3_merge sequences)
   (let lp ((result '()))
     (set! sequences (for ((s : sequences)) ((l '()))
 			 (if (bool s)
-			     (cond s l)
+			     (cons s l)
 			     l)
 			 #:final (reverse l)))
     (if (bool sequences)
@@ -525,7 +526,7 @@
 		     (let ((cand (pylist-ref (car s1) 0)))
 		       (let lp3 ((s2 sequences))
 			 (if (pair? s2)
-			     (if (in cand (pylist-slice! (car s2) 1 None None))
+			     (if (in cand (pylist-slice (car s2) 1 None None))
 				 (lp2 (cdr s1))
 				 (lp3 (cdr s2)))
 			     cand)))
@@ -543,22 +544,6 @@
 	(py-list (reverse result)))))
 
 (def (_c3_mro cls (= abcs None))
-    "Computes the method resolution order using extended C3 linearization.
-
-    If no *abcs* are given, the algorithm works exactly like the built-in C3
-    linearization used for method resolution.
-
-    If given, *abcs* is a list of abstract base classes that should be inserted
-    into the resulting MRO. Unrelated ABCs are ignored and don't end up in the
-    result. The algorithm inserts ABCs where their functionality is introduced,
-    i.e. issubclass(cls, abc) returns True for the class itself but returns
-    False for all its direct base classes. Implicit ABCs for a given class
-    (either registered or inferred from the presence of a special method like
-    __len__) are inserted directly after the last ABC explicitly listed in the
-    MRO of said class. If two implicit ABCs end up next to each other in the
-    resulting MRO, their ordering depends on the order of types in *abcs*.
-
-    "
     (define bases (ref cls '__bases__ '()))
     (define boundary
       (for ((i base : (enumerate (reversed bases)))) ()
@@ -576,7 +561,7 @@
 		  (not (any (map (lambda (b) (issubclass b base)) bases))))
 	     (pylist-append! abstract_bases base)))
 
-    (for ((base : abstract_bases))
+    (for ((base : abstract_bases)) ()
 	 (pylist-remove! abcs base))
     
     (let* ((f (lambda (bases)
@@ -594,7 +579,7 @@
 	  abstract_c3_mros
 	  other_c3_mros
 	  (py-list explicit_bases)
-	  (py-lit abstract_bases)
+	  (py-list abstract_bases)
 	  (py-list other_bases)))))
 
 (define (_compose_mro cls types)
@@ -616,7 +601,7 @@
 		       (if (is_related n)
 			   (cons n l)
 			   l)
-		       #final (reverse l)))
+		       #:final (reverse l)))
     
     ;; Remove entries which are strict bases of other entries (they will end up
     ;; in the MRO anyway.
@@ -631,7 +616,7 @@
 			(if (is_strict_base n)
 			   (cons n l)
 			   l)
-		       #final (reverse l)))
+		       #:final (reverse l)))
     
     ; Subclasses of the ABCs in *types* which are also implemented by
     ; *cls* can be used to stabilize ABC ordering.
@@ -640,24 +625,24 @@
     
     (for ((typ : types)) ()
 	 (let ((found (py-list)))
-	   (for ((sub in ((ref typ '__subclasses__ (lambda () '()))))) ()
+	   (for ((sub : ((ref typ '__subclasses__ (lambda () '()))))) ()
 		(if (and (not (in sub bases))
 			 (issubclass cls sub))
-		    (pylist-append found
-				   (for ((s in (ref sub '__mro__ '())))
-					((l '()))
-				      (if (in s type_set)
-					  (cons s l)
-					  l)
-				      #:final (py-list (reverse l))))))
-	   (f (not (bool found))
-	      (begin
-		(pylist-append! mro typ)
-		(pylist-sort! found #:key len #:reverse #t)
-		(for ((sub : found)) ()
-		     (for ((subcls : sub)) ()
-			  (if (not (in subcls mro))
-			      (pylist-append! mro subcls))))))))
+		    (pylist-append! found
+				    (for ((s : (ref sub '__mro__ '())))
+					 ((l '()))
+					 (if (in s type_set)
+					     (cons s l)
+					     l)
+					 #:final (py-list (reverse l))))))
+	   (if (not (bool found))
+	       (begin
+		 (pylist-append! mro typ)
+		 (pylist-sort! found #:key len #:reverse #t)
+		 (for ((sub : found)) ()
+		      (for ((subcls : sub)) ()
+			   (if (not (in subcls mro))
+			       (pylist-append! mro subcls))))))))
 
     (_c3_mro cls #:abcs mro))
 
@@ -692,6 +677,8 @@
     
     (py-get registry match))
 
+(define (get_cache_token) #t)
+
 (define (singledispatch func)
     "Single-dispatch generic function decorator.
 
@@ -718,7 +705,7 @@
             (let ((current_token (get_cache_token)))
 	      (if (not (equal? cache_token current_token))
 		  (begin
-		    (pylist-clear! dispatch_cache)
+		    (py-clear dispatch_cache)
 		    (set! cache_token current_token)))))
 
 	(let ((impl (try
@@ -742,7 +729,7 @@
 	      (if (and (eq? cache_token None)
 		       (ref cls '__abstractmethods__))
 		  (set! cache_token (get_cache_token)))
-	      (pylist-clear! dispatch_cache)
+	      (py-clear dispatch_cache)
 	      func)))
 
     (def (wrapper (* args) (** kw))
@@ -757,4 +744,4 @@
     (update_wrapper wrapper func)
 
     wrapper)
-|#
+
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 2b1e368..99db1c2 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -4,7 +4,8 @@
   #:use-module (ice-9 readline)
   #:use-module ((oop pf-objects) #:select
                 (<p> <property> class-method static-method ref
-                     py-super-mac type object pylist-ref))
+                     py-super-mac type object pylist-ref define-python-class
+		     object-method))
   #:use-module (language python exceptions       )
   #:use-module ((language python module string   ) #:select ())
   #:use-module (language python def              )
@@ -42,11 +43,12 @@
   
   #:export (print repr complex float int str
                   set all any bin callable reversed
-                  chr classmethod staticmethod
+                  chr classmethod staticmethod objectmethod
                   divmod enumerate filter open
                   getattr hasattr setattr hex isinstance issubclass
                   iter map sum id input oct ord pow super
-                  sorted zip))
+                  sorted zip
+		  ClassMethod StaticMethod Funcobj))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -87,6 +89,7 @@
 
 (define chr integer->char)
 
+(define objectmethod object-method)
 (define classmethod  class-method)
 (define staticmethod static-method)
 
@@ -121,8 +124,10 @@
 
 (define-method (issubclass (sub <p>) (cls <p>))
   (aif it (ref cls '__subclasscheck__)
-       (it sub)
-       (is-a? (ref sub '__goops__) (ref cls '__goops__))))
+       (it cls sub)
+       (if (eq? sub cls)
+	   #t
+	   (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
 
 (define-method (isinstance (o <p>) (cl <p>))
   (aif it (ref cl '__instancecheck__)
@@ -300,6 +305,11 @@
           (setvbuf port 'block buffering)))
 
        port))
+
+
+(define-python-class ClassMethod  ())
+(define-python-class StaticMethod ())
+(define-python-class Funcobj      ())
      
            
      
diff --git a/modules/language/python/module/weakref.scm b/modules/language/python/module/weakref.scm
index 61f845a..bd7b7dd 100644
--- a/modules/language/python/module/weakref.scm
+++ b/modules/language/python/module/weakref.scm
@@ -1,10 +1,11 @@
 (define-module (language python module weakref)
   #:use-module (language python dict)
-  #:export (WeakKeyDictionary WeakValueDictionary))
+  #:use-module (language python set)
+  #:export (WeakKeyDictionary WeakValueDictionary WeakSet))
 
 (define WeakKeyDictionary   weak-key-dict)
 (define WeakValueDictionary weak-value-dict)
-
+(define WeakSet             weak-set)
   
 
   
diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm
index d5d36f6..5582d36 100644
--- a/modules/language/python/set.scm
+++ b/modules/language/python/set.scm
@@ -9,7 +9,7 @@
   #:use-module (language python yield)
   #:use-module (language python persist)
   #:use-module (language python bool)
-  #:export (py-set frozenset))
+  #:export (py-set frozenset weak-set))
 
 (define-class <set> () dict)
 (name-object <set>)
@@ -30,7 +30,8 @@
 
 
 (define miss (list 'miss))
- 
+
+(define-syntax-rule (mk set make-py-hashtable)
 (define-python-class set (<set>)
   (define __init__
     (case-lambda
@@ -231,11 +232,15 @@
        (equal? (ref self 'd 1)      (ref x 'd 2)))))
                  
   (define __iter__
-    (make-generator (self)
-        (lambda (yield self)
-          (for ((k v : (slot-ref self 'dict))) ()
-               (yield k)
-               (values))))))
+    (lambda (self)
+      ((make-generator ()
+	  (lambda (yield)
+	    (for ((k v : (slot-ref self 'dict))) ()
+		 (yield k)
+		 (values)))))))))
+
+(mk set      make-py-hashtable)
+(mk weak-set make-py-weak-key-hashtable)
 
 (define py-set set)
 (define-python-class frozenset (set))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index b239fc2..0c82dfe 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -90,7 +90,7 @@ explicitly tell it to not update etc.
 
 (define (mk-getter-object f)
   (lambda (obj cls)
-    (if (eq? obj cls)
+    (if (or (pyclass? obj) (pytype? obj))
 	(lambda x (apply f x))
 	(lambda x (apply f obj x)))))
 
@@ -159,30 +159,33 @@ explicitly tell it to not update etc.
 
 (define (hashforeach a b) (values))
 
+(define (new-class0 meta name parents dict . kw)
+  (let* ((goops (pylist-ref dict '__goops__))
+	 (p     (kwclass->class kw meta))
+	 (class (make-p p)))
+    (slot-set! class 'procedure
+	       (lambda x
+		 (create-object class meta goops x)))
+    (if (hash-table? dict)
+	(hash-for-each
+	 (lambda (k v) k (set class k v))
+	 dict)
+	(hashforeach
+	 (lambda (k v) k (set class k v))
+	 dict))
+    (let((mro (ref class '__mro__)))
+      (if (pair? mro)
+	  (let ((p (car mro)))
+	    (aif it (ref p '__init_subclass__)
+		 (apply it class #f kw)
+		 #f))))
+    (set class '__mro__ (cons class (ref class '__mro__)))
+    class))
+
 (define (new-class meta name parents dict kw)
   (aif it (ref meta '__new__)
-       (apply it name parents dict kw)
-       (let* ((goops (pylist-ref dict '__goops__))
-              (p     (kwclass->class kw meta))
-              (class (make-p p)))
-	 (slot-set! class 'procedure
-                    (lambda x
-                      (create-object class meta goops x)))
-         (if (hash-table? dict)
-             (hash-for-each
-              (lambda (k v) k (set class k v))
-              dict)
-             (hashforeach
-              (lambda (k v) k (set class k v))
-              dict))
-         (let((mro (ref class '__mro__)))
-           (if (pair? mro)
-               (let ((p (car mro)))
-                 (aif it (ref p '__init_subclass__)
-                      (apply it class #f kw)
-                      #f))))
-         (set class '__mro__ (cons class (ref class '__mro__)))
-         class)))
+       (apply it meta name parents dict kw)
+       (apply new-class0 meta name parents dict kw)))
 
 (define (type- meta name parents dict keys)
   (let ((class (new-class meta name parents dict keys)))
@@ -657,17 +660,11 @@ explicitly tell it to not update etc.
 
 (define (defaulter d)
   (if d
-      (cond
-       ((is-a? d <pyf>)
-        <pyf>)
-       ((is-a? d <py>)
-        <py>)
-       ((is-a? d <pf>)
-        <pf>)
-       ((is-a? d <p>)
-        <p>)
-       (else
-        d))
+      (aif it (ref d '__goops__)
+	   it
+	   (if (is-a? d <py>)
+	       <py>
+	       <p>))
       <py>))
 
 (define (kwclass->class kw default)
@@ -696,6 +693,7 @@ explicitly tell it to not update etc.
                       <pyf>
                       <py>)
                   (defaulter default))))))
+
 (define type   #f)
 (define object #f)
 (define (make-p-class name supers.kw methods)
@@ -714,7 +712,7 @@ explicitly tell it to not update etc.
                         p)))
   
   (define meta (aif it (memq #:metaclass kw)
-                    (car it)
+                    (cadr it)
                     (if (null? parents)
                         type
                         (let* ((p   (car parents))
@@ -902,11 +900,15 @@ explicitly tell it to not update etc.
         (cons (reverse r) '()))))
 
 (define-syntax-rule (define-python-class name (parents ...) code ...)
-  (define name (mk-p-class name (arglist->pkw (list parents ...)) code ...)))
+  (define name
+    (syntax-parameterize ((*class* (lambda (x) #'name)))
+       (mk-p-class name (arglist->pkw (list parents ...)) code ...))))
 
 (define-syntax-rule (define-python-class-noname name (parents ...) code ...)
-  (define name (mk-p-class-noname name (arglist->pkw (list parents ...))
-				  code ...)))
+  (define name
+    (syntax-parameterize ((*class* (lambda (x) #'name)))
+      (mk-p-class-noname name (arglist->pkw (list parents ...))
+			 code ...))))
 
 
 (define-syntax make-python-class
@@ -945,27 +947,32 @@ explicitly tell it to not update etc.
 (define (not-a-super) 'not-a-super)
 (define (py-super class obj)
   (define (make cl parents)
-    (let ((c (make-p <p>))
-          (o (make-p <p>)))
-      (set c '__super__        #t)
-      (set c '__mro__       parents)
-      (set c '__getattribute__  (lambda (self key . l)
-                                  (aif it (ref c key)
-                                       (if (procedure? it)
-                                           (if (eq? (procedure-property
-                                                     it
-                                                     'py-special)
-                                                    'class)
-                                               (it cl)
-                                               (it obj))
-                                           it)
-                                       (error "no attribute"))))
-      (set o '__class__ c)
-      o))
+    (if (or (pyclass? obj) (pytype? obj))
+	cl
+	(let ((c (make-p <p>))
+	      (o (make-p <p>)))
+	  (set c '__super__        #t)
+	  (set c '__mro__          parents)
+	  (set c '__getattribute__  (lambda (self key . l)
+				      (aif it (ref c key)
+					   (if (procedure? it)
+					       (if (eq? (procedure-property
+							 it
+							 'py-special)
+							'class)
+						   (it cl)
+						   (it obj))
+					       it)
+					   (error "no attribute"))))
+	  (set o '__class__ c)
+	  o)))
   
   (call-with-values
       (lambda ()
-        (let lp ((l (ref (ref obj '__class__) '__mro__ '())))
+        (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)))
@@ -1105,6 +1112,7 @@ explicitly tell it to not update etc.
 
 (set! type
       (make-python-class type ()
+	(define __new__ new-class0)		 
         (define __call__
           (case-lambda
             ((meta obj)