progressively imporoving the conformance with python3
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 15 Apr 2018 20:29:50 +0000 (22:29 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 15 Apr 2018 20:29:50 +0000 (22:29 +0200)
modules/language/python/compile.scm
modules/language/python/def.scm
modules/language/python/dict.scm
modules/language/python/exceptions.scm
modules/language/python/module/enum.py
modules/language/python/module/python.scm
modules/language/python/number.scm
modules/language/python/set.scm
modules/oop/pf-objects.scm

index fc4a1c743821895d3156e39977a9a29719b49491..a54dab8e1fc9904cc469b5b517a5b3c4b508f8c5 100644 (file)
@@ -44,7 +44,9 @@
 (define-syntax-rule (use a ...)
   (catch #t
     (lambda () (use-modules a ...))
-    (lambda x (raise (ImportError '(a ...))))))
+    (lambda x
+      (warn "failed to load " x)
+      (raise (ImportError '(a ...))))))
 
 (define s/d 'set!)
 
                 (union vs (list (exp '() (if as as (car ids)))))))
           vs)))
 
-    ((#:expr-stmt l (#:assign u))
-     (union (fold (lambda (x s)
-                   (match x
-                     ((#:test (#:power v2 v1 () . _) . _)
-                      (if v2
-                          (union
-                           (union (list (exp '() v1))
-                                  (list (exp '() v2)))
-                           s)
-                          (union (list (exp '() v1)) s)))
-                     (_ s)))
-                  '()              
-                  l)
-            vs))
+    ((#:expr-stmt l (#:assign u ... v))
+     (union
+      (fold (lambda (l s)
+              (union
+               s
+               (fold (lambda (x s)
+                       (match x
+                         ((#:test (#:power v2 v1 () . _) . _)
+                          (if v2
+                              (union
+                               (union (list (exp '() v1))
+                                      (list (exp '() v2)))
+                               s)
+                              (union (list (exp '() v1)) s)))
+                         (_ s)))
+                     '()              
+                     l)))              
+            '()
+            (cons l u))
+      vs))
+
+    ((#:for es in code . final)
+     (let ((vs (let lp ((es es))
+                 (match es
+                   (((#:power #f (#:tuple . l) . _))
+                    (lp l))
+                   (_ (union vs (map (g vs exp) es)))))))
+       (scope final (scope code vs))))
 
+     
     ((#:expr-stmt l (#:assign k . u))
      (union
       (union (fold (lambda (x s)
     ((x . y)
      (scope y (scope x vs)))
     (_ vs)))
-
+  
 (define (defs x vs)
   (match x
     ((#:def  (#:identifier f) . _)
     #:final
     (reverse l)))
 
-(define (arglist->pkw . l)
+(define (arglist->pkw  l)
   (let lp ((l l) (r '()))
     (if (pair? l)
         (let ((x (car l)))
-          (if (keyword? x)
-              (cons (reverse r) l)
-              (lp (cdr l) (cons x r))))
-        (cons (reverse l) '()))))
+          (if  (keyword? x)
+               (list (G 'cons) `(,(G 'list) ,@(reverse r)) `(,(G 'list) ,@l))
+               (lp (cdr l) (cons x r))))
+        (list (G 'cons)  `(,(G 'list) ,@(reverse r)) ''()))))
 
 (define (get-addings vs x)
   (match x
    ((_ class parents code)
     (with-fluids ((is-class? #t))
       (let ()
+        (define (clean l)
+          (match l
+            (((#:apply   . l). u) (append (clean l) (clean u)))
+            (((`= x v ) . l) (cons* (symbol->keyword x) v (clean l)))
+            ((x         . l) (cons x (clean l)))
+            (() '())))
         (let* ((decor   (let ((r (fluid-ref decorations)))
                           (fluid-set! decorations '())
                           r))               
                (,(C 'mk-p-class2)
                 ,class                
                 ,(if parents
-                     `(,(C 'ref-x) ,(C 'arglist->pkw) ,@parents)
+                     (arglist->pkw (clean parents))
                      `(,(G 'cons) '() '()))
                 ,(map (lambda (x) `(define ,x #f)) ls)
                 ,(exp vs code))))))))))
          (dd*  (map cadr *f))
           (**f  (get-args** vs args))
          (dd** (map cadr **f))
+          (aa  `(,@arg_ ,@*f ,@arg= ,@**f))
           (ab  (gensym "ab"))
           (vs  (union dd** (union dd* (union dd= (union args vs)))))
           (ns  (scope code vs))
                `(set! ,f
                   (,(C 'def-decor) ,decor
                    (,(C 'def-wrap) ,y? ,f ,ab
-                    (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+                    (,(D 'lam) ,aa
                      (,(C 'with-return) ,r
                       ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                              (,(C 'with-self) ,c? ,args
+                              (,(C 'with-self) ,c? ,aa
                                ,(with-fluids ((return r))
                                    (exp ns code))))))))))
                
                `(set! ,f
                   (,(C 'def-decor) ,decor
-                   (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+                   (,(D 'lam) ,aa
                     (,(C 'with-return) ,r
                      ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                             (,(C 'with-self) ,c? ,args
+                             (,(C 'with-self) ,c? ,aa
                              ,(with-fluids ((return r))
                                 (exp ns code))))))))))
             
                `(set! ,f
                   (,(C 'def-decor) ,decor
                    (,(C 'def-wrap) ,y? ,f ,ab
-                    (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+                    (,(D 'lam) ,aa
                      (,(C 'with-return) ,r 
                       (let ,(map (lambda (x) (list x #f)) ls)
-                        (,(C 'with-self) ,c? ,args
+                        (,(C 'with-self) ,c? ,aa
                          ,(with-fluids ((return r))
                             (mk
                              (exp ns code))))))))))
                `(set! ,f
                   (,(C 'def-decor) ,decor
-                   (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+                   (,(D 'lam) ,aa
                     (,(C 'with-return) ,r 
                      (let ,(map (lambda (x) (list x #f)) ls)
-                       (,(C 'with-self) ,c? ,args
+                       (,(C 'with-self) ,c? ,aa
                         ,(with-fluids ((return r))
                            (exp ns code))))))))))))))
  
         (car l)
         `(,(G 'values) ,@l))))
 
-  ((_ l (#:assign x y . u))
+  ((_ a (#:assign b c . u))
    (let ((z (gensym "x")))
-     `(let ((,x ,(exp vs `(#:expr-stmt1 ((#:verb ,z)) (#:assign ,y . ,u)))))
-        ,(exp vs `(#:expr-stmt ,x (#:assign ((#:verb ,z))))))))
+     `(let ((,z ,(exp vs `(#:expr-stmt1 ,b (#:assign ,c . ,u)))))
+        ,(exp vs `(#:expr-stmt ,a (#:assign ((#:verb ,z))))))))
   
   ((_ l type)
    (=> fail)
 
   
  (#:expr-stmt1
-  ((_ l (#:assign x y . u))
+  ((_ a (#:assign b c . u))
    (let ((z (gensym "x")))
-     `(let ((,x ,(exp vs `(#:expr-stmt1 ((#:verb ,z))
-                                        (#:assign ,y . ,u)))))
-        ,(exp vs `(#:expr-stmt ,x (#:assign ((#:verb ,z))))))))
+     `(let ((,z ,(exp vs `(#:expr-stmt1 ,b
+                                        (#:assign ,c . ,u)))))
+        ,(exp vs `(#:expr-stmt1 ,a (#:assign ((#:verb ,z))))))))
   
   ((_ l type)
    (=> fail)
      (if (pair? a)
          (let lp ((l a))
            (if (pair? l)
-               (let ((x (car l)))
+               (begin
+                 (set! x (car l))
                  (with-sp ((continue (lp (cdr l)))
                            (break    (values)))                          
                           code
              (if (pair? l)
                  (begin
                    (let/ec continue-ret
-                     (let ((x (car l)))
-                       (with-sp ((continue (continue-ret))
-                                 (break    (break-ret)))                     
-                         code)))
+                     (set! x (car l))
+                     (with-sp ((continue (continue-ret))
+                               (break    (break-ret)))                     
+                              code))
                    (lp (cdr l))))))
          (for/adv1 (x) (a) code #f #t)))
 
      (if (pair? a)
          (let/ec break-ret
            (let ((x (let lp ((l a) (old #f))
-                      (if (pair? l)                          
-                          (let ((x (car l)))
+                      (if (pair? l)
+                          (begin
+                            (set! x (car l))
                             (let/ec continue-ret
                               (with-sp ((continue (continue-ret))
                                         (break    (break-ret)))
-                                code))
+                                       code))
                             (lp (cdr l)))
                           old))))
              next))
   (lambda (x)
     (syntax-case x ()
       ((_ (x ...) (in) code #f #f)
-       (with-syntax ((inv (gentemp #'in)))
+       (with-syntax ((inv      (gentemp #'in))
+                     ((xx ...) (generate-temporaries #'(x ...))))
          #'(let ((inv (wrap-in in)))
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (next inv))
-                     (lambda (x ...)
+                     (lambda (xx ...)
+                       (set! x xx) ... 
                        (with-sp ((break    (values))
                                  (continue (values)))
                                 code
                (lambda z (values))))))
 
       ((_ (x ...) (in ...) code #f #f)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+       (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
+                     ((xx  ...) (generate-temporaries #'(x ...))))
          #'(let ((inv (wrap-in in)) ...)
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (values (next inv) ...))
-                     (lambda (x ...)
+                     (lambda (xx ...)
+                       (set! x xx) ...
                        (with-sp ((break    (values))
                                  (continue (values)))
-                          code
-                          (lp))))))
+                                code
+                                (lp))))))
                (lambda z (values))))))
 
       ((_ (x ...) (in) code #f #t)
-       (with-syntax ((inv (gentemp #'in)))          
+       (with-syntax ((inv       (gentemp #'in))
+                     ((xx  ...) (generate-temporaries #'(x ...))))
           #'(let ((inv (wrap-in in)))
               (let lp ()
                 (let/ec break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (next inv))
-                        (lambda (x ...)
+                        (lambda (xx ...)
+                          (set! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                     (lambda z (values))))))))
 
       ((_ (x ...) (in ...) code #f #t)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))          
+       (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
+                     ((xx  ...) (generate-temporaries #'(x ...))))
           #'(let ((inv (wrap-in in)) ...)
               (let lp ()
                 (let/ec break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
-                        (lambda (x ...)
+                        (lambda (xx ...)
+                          (set! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
            (if (syntax->datum #'p)
                #'(let ((inv (wrap-in in)))               
                    (let/ec break-ret
-                     (let ((x #f) ...)
-                       (catch StopIteration
-                         (lambda ()
-                           (let lp ()
-                             (call-with-values (lambda () (next inv))
-                               (lambda (xx ...)
-                                 (set! x xx) ...
-                                 (let/ec continue-ret
-                                   (with-sp ((break     (break-ret))
-                                             (continue  (continue-ret)))
-                                            code))
-                                 (lp)))))
-                         (lambda q else)))))
-             
-               #'(let ((inv (wrap-in in)))
-                   (let ((x #f) ...)
-                     (let/ec break-ret
-                       (catch StopIteration
-                         (lambda ()
-                           (let lp ()
-                             (call-with-values (lambda () (next inv))
-                               (lambda (xx ...)
-                                 (set! x xx) ...
-                                 (with-sp ((break     (break-ret))
-                                           (continue  (values)))
-                                          code)
-                                 (lp)))))
-                         (lambda e else)))))))))
-      
-      ((_ (x ...) (in ...) code else p)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
-       (with-syntax ((get      (gen #'(inv ...) #'(x ...)))
-                     ((xx ...) (generate-temporaries #'(x ...))))
-         (if (syntax->datum #'p)
-             #'(let ((inv (wrap-in in)) ...)               
-                 (let/ec break-ret
-                   (let ((x #f) ...)
                      (catch StopIteration
                        (lambda ()
                          (let lp ()
-                           (call-with-values (lambda () get)
+                           (call-with-values (lambda () (next inv))
                              (lambda (xx ...)
                                (set! x xx) ...
                                (let/ec continue-ret
                                  (with-sp ((break     (break-ret))
                                            (continue  (continue-ret)))
-                                   code))
+                                          code))
                                (lp)))))
-                       (lambda q else)))))
+                       (lambda q else))))
              
-             #'(let ((inv (wrap-in in)) ...)
-                 (let ((x #f) ...)
+               #'(let ((inv (wrap-in in)))
                    (let/ec break-ret
                      (catch StopIteration
                        (lambda ()
                          (let lp ()
-                           (call-with-values (lambda () get)
+                           (call-with-values (lambda () (next inv))
                              (lambda (xx ...)
                                (set! x xx) ...
                                (with-sp ((break     (break-ret))
                                          (continue  (values)))
                                         code)
                                (lp)))))
-                       (lambda e else))))))))))))
-    
+                       (lambda e else))))))))
+      
+      ((_ (x ...) (in ...) code else p)
+       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+       (with-syntax ((get      (gen #'(inv ...) #'(x ...)))
+                     ((xx ...) (generate-temporaries #'(x ...))))
+         (if (syntax->datum #'p)
+             #'(let ((inv (wrap-in in)) ...)               
+                 (let/ec break-ret
+                   (catch StopIteration
+                     (lambda ()
+                       (let lp ()
+                         (call-with-values (lambda () get)
+                           (lambda (xx ...)
+                             (set! x xx) ...
+                             (let/ec continue-ret
+                               (with-sp ((break     (break-ret))
+                                         (continue  (continue-ret)))
+                                        code))
+                             (lp)))))
+                     (lambda q else))))
+             
+             #'(let ((inv (wrap-in in)) ...)
+                 (let/ec break-ret
+                   (catch StopIteration
+                     (lambda ()
+                       (let lp ()
+                         (call-with-values (lambda () get)
+                           (lambda (xx ...)
+                             (set! x xx) ...
+                             (with-sp ((break     (break-ret))
+                                       (continue  (values)))
+                                      code)
+                             (lp)))))
+                     (lambda e else)))))))))))
+
 (define-syntax def-wrap
   (lambda (x)
     (syntax-case x ()
 
 (define-syntax ref-x
   (lambda (x)
-    (syntax-case x ()
+    (syntax-case x (quote __dict__)
       ((_ v)
        #'v)
       ((_ v (#:fastfkn-ref f _) . l)
        #'(ref-x (lambda x (if (pyclass? v) (apply f x) (apply f v x))) . l))
       ((_ v (#:fast-id f _) . l)
        #'(ref-x (f v) . l))
+      ((_ v (#:identifier '__dict__) . l)
+       #'(ref-x (py-dict v) . l))
       ((_ v (#:identifier x) . l)
        #'(ref-x (wr x (ref v x miss)) . l))
       ((_ v (#:call-obj x) . l)
index 5c83b6f8de3fcc8580945e26a2f086333ec67bb3..fa4cbc52f0a97ed3aa50d2b5be2bd48ef5106fe5 100644 (file)
               (ww- (fold get-ww '() #'(arg ...)))
               (kv  (fold get-kv '() #'(arg ...))))
          (if (and-map null? (list kw ww- kv))
-             #`(object-method (lambda #,as code ...))
+             #`(object-method
+                (lambda (#,@as . u12345678)
+                  (if (and (pair? u12345678)
+                           (not (keyword? (car u12345678))))
+                      (raise  (ArgumentError "too many arguments to function")))
+                  code ...))
              (with-syntax ((kw      (if (null? kw)
                                         (datum->syntax x (gensym "kw"))
                                         (car kw)))
index 260aa0de1b2036ecd98f951d28331089118588eb..977d5e14fde7a0ed1702bef703ee6742f2a74b93 100644 (file)
 
 (define H (hash 1333674836 complexity))
 
-(define-class <py-hashtable> () t h n)
+(define-class <py-hashtable> () t hash n)
 
 (name-object <py-hashtable>)
 
 (cpit <py-hashtable>
       (o (lambda (o h n a)
-          (slot-set! o 'h h)
+          (slot-set! o 'hash h)
           (slot-set! o 'n n)
           (slot-set! o 't
                      (let ((t (make-hash-table)))
@@ -62,7 +62,7 @@
                        t)))
         (let ((t (slot-ref o 't)))
           (list
-           (slot-ref o 'h)
+           (slot-ref o 'hash)
            (slot-ref o 'n)
            (hash-fold (lambda (k v s) (cons (cons k v) s)) '() t)))))
 
@@ -71,7 +71,7 @@
          (t (make-hash-table))
          (h H))
     (slot-set! o 't    t)
-    (slot-set! o 'h    h)
+    (slot-set! o 'hash h)
     (slot-set! o 'n    0)
     o))
 
@@ -80,7 +80,7 @@
          (t (make-weak-key-hash-table))
          (h H))
     (slot-set! o 't    t)
-    (slot-set! o 'h    h)
+    (slot-set! o 'hash h)
     (slot-set! o 'n    0)
     o))
 
@@ -89,7 +89,7 @@
          (t (make-weak-value-hash-table))
          (h H))
     (slot-set! o 't    t)
-    (slot-set! o 'h    h)
+    (slot-set! o 'hash h)
     (slot-set! o 'n    0)
     o))
 
 (define-method (pyhash-rem! (o <py-hashtable>) k)
   (let ((t (slot-ref o 't))
         (n (slot-ref o 'n))
-        (h (slot-ref o 'h)))
+        (h (slot-ref o 'hash)))
     (let ((ret (py-hash-ref t k miss)))
       (if (eq? ret miss)
           (values)
           (begin
             (py-hash-remove! t k)
-            (slot-set! o 'n (- n 1))
-            (slot-set! o 'h (logxor h (xy (py-hash k) (py-hash ret))))
+            (slot-set! o 'n    (- n 1))
+            (slot-set! o 'hash (logxor h (xy (py-hash k) (py-hash ret))))
             (values))))))
 
 (define-method (pylist-pop! (o <py-hashtable>) k . l)
 (define-method (pylist-set! (o <py-hashtable>) key val)
   (let ((t (slot-ref o 't))
         (n (slot-ref o 'n))
-        (h (slot-ref o 'h)))
+        (h (slot-ref o 'hash)))
     (let ((ret (py-hash-ref t key miss)))
       (if (eq? ret miss)
           (begin
             (py-hash-set! t key val)            
             (slot-set! o 'n (+ n 1))
-            (slot-set! o 'h (logxor (xy (py-hash key) (py-hash val)) h)))
+            (slot-set! o 'hash (logxor (xy (py-hash key) (py-hash val)) h)))
           (begin
             (py-hash-set! t key val)
-            (slot-set! o 'h
+            (slot-set! o 'hash
                        (logxor (xy (py-hash key) (py-hash val))
                                (logxor
                                 (xy (py-hash key) (py-hash ret))
 
   (<py-hashtable>
    (let ((r (make <py-hashtable>)))
-     (slot-set! r 'h (slot-ref o 'h))
+     (slot-set! r 'hash (slot-ref o 'hash))
      (slot-set! r 'n (slot-ref o 'n))
      (slot-set! r 't (py-copy (slot-ref o 't)))
      r)))
    (let ((elseval (match l
                     (()  None)
                     ((v) v))))
-     (let ((ret (py-hash-ref o k miss)))
+     (let ((ret (ref o k miss)))
        (if (eq? ret miss)
            elseval
            ret))))
    (let ((elseval (match l
                     (()  None)
                     ((v) v))))
-     (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
+     (let ((ret (ref (slot-ref o 't) k miss)))
        (if (eq? ret miss)
            elseval
            ret)))))
    (let ((t (slot-ref o 't)))
      (hash-clear! t)
      (slot-set! o 'n 0)
-     (slot-set! o 'h H)
+     (slot-set! o 'hash H)
      (values))))
 
 #|        
 
 (define-method (py-equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
   (and
-   (equal? (slot-ref o1 'n) (slot-ref o2 'n))
-   (equal? (slot-ref o1 'h) (slot-ref o2 'h))
-   (e?     (slot-ref o1 't) (slot-ref o2 't))))
+   (equal? (slot-ref o1 'n)    (slot-ref o2 'n))
+   (equal? (slot-ref o1 'hash) (slot-ref o2 'hash))
+   (e?     (slot-ref o1 't)    (slot-ref o2 't))))
 
 (define (e? t1 t2)
   (let/ec ret
     (letrec ((__init__
               (case-lambda
                 ((self)
-                 (let ((r (make-py-hashtable)))
-                   (slot-set! self 't (slot-ref r 't))
-                   (slot-set! self 'h (slot-ref r 'h))
-                   (slot-set! self 'n (slot-ref r 'n))))
+                 (let ((r (make-hash-table)))
+                   (slot-set! self 't    r)
+                   (slot-set! self 'hash H)
+                   (slot-set! self 'n    0)))
                 ((self x)
-                 (__init__ self)
+                 (__init__ self)           
                  (catch #t
                    (lambda ()
                      (for ((k v : x)) ()
     (letrec ((__init__
               (case-lambda
                 ((self)
-                 (let ((r (make-py-weak-key-hashtable)))
-                   (slot-set! self 't (slot-ref r 't))
-                   (slot-set! self 'h (slot-ref r 'h))
-                   (slot-set! self 'n (slot-ref r 'n))))
+                 (let ((r (make-hash-table)))
+                   (slot-set! self 't    r)
+                   (slot-set! self 'hash H)
+                   (slot-set! self 'n    0)))
+                
                 ((self x)
                  (__init__ self)
                  (if (is-a? x <py-hashtable>)
     (letrec ((__init__
               (case-lambda
                 ((self)
-                 (let ((r (make-py-weak-value-hashtable)))
-                   (slot-set! self 't (slot-ref r 't))
-                   (slot-set! self 'h (slot-ref r 'h))
-                   (slot-set! self 'n (slot-ref r 'n))))
+                 (let ((r (make-hash-table)))
+                   (slot-set! self 't    r)
+                   (slot-set! self 'hash H)
+                   (slot-set! self 'n    0)))
+
                 ((self x)
                  (__init__ self)
                  (if (is-a? x <py-hashtable>)
index 93ce54d212bee450e605c02112ac869708414fbe..9d51116a8c556cb1b1e809f08cf419e5dc05996c 100644 (file)
@@ -3,7 +3,7 @@
   #:use-module (oop goops)
   #:export (StopIteration GeneratorExit RuntimeError
                           Exception ValueError TypeError
-                          IndexError KeyError AttributeError
+                          IndexError KeyError AttributeError  ArgumentError
                           SyntaxError SystemException
                           OSError ProcessLookupError PermissionError
                           None NotImplemented NotImplementedError
@@ -40,6 +40,7 @@
 (define-er SystemException     'SystemException)
 (define-er RuntimeError        'RuntimeError)
 (define-er IndexError          'IndexError)
+(define-er ArgumentError       'IndexError)
 (define-er ValueError          'ValueError)
 (define None                   'None)
 (define-er KeyError            'KeyError)
index 89047cd5b60fafe194297254bd02cc8606381b96..1549862cb8d389c052ca4d9d9a24b4b0bd5e64ed 100644 (file)
@@ -11,7 +11,6 @@ try:
 except ImportError:
     from collections import OrderedDict
 
-
 __all__ = [
         'EnumMeta',
         'Enum', 'IntEnum', 'Flag', 'IntFlag',
@@ -50,6 +49,8 @@ def _make_class_unpicklable(cls):
     cls.__module__ = '<unknown>'
 
 _auto_null = object()
+
+
 class auto:
     """
     Instances are replaced with an appropriate value in Enum class suites.
@@ -117,10 +118,14 @@ class EnumMeta(type):
     def __prepare__(metacls, cls, bases):
         # create the namespace dict
         enum_dict = _EnumDict()
+        pk('got dict')
+        
         # inherit previous flags and _generate_next_value_ function
         member_type, first_enum = metacls._get_mixins_(bases)
+
         if first_enum is not None:
             enum_dict['_generate_next_value_'] = getattr(first_enum, '_generate_next_value_', None)
+
         return enum_dict
 
     def __new__(metacls, cls, bases, classdict):
@@ -128,42 +133,45 @@ class EnumMeta(type):
         # cannot be mixed with other types (int, float, etc.) if it has an
         # inherited __new__ unless a new __new__ is defined (or the resulting
         # class will fail).
+        pk('new enum meta')
         member_type, first_enum = metacls._get_mixins_(bases)
         __new__, save_new, use_args = metacls._find_new_(classdict, member_type,
                                                         first_enum)
-
+        pk(1)
         # save enum items into separate mapping so they don't get baked into
         # the new class
         enum_members = {k: classdict[k] for k in classdict._member_names}
         for name in classdict._member_names:
             del classdict[name]
-
+        pk(2)
         # adjust the sunders
         _order_ = classdict.pop('_order_', None)
-
+        pk(3)
         # check for illegal enum names (any others?)
         invalid_names = set(enum_members) & {'mro', }
         if invalid_names:
             raise ValueError('Invalid enum member name: {0}'.format(
                 ','.join(invalid_names)))
-
+        pk(4)
         # create a default docstring if one has not been provided
         if '__doc__' not in classdict:
             classdict['__doc__'] = 'An enumeration.'
-
+        pk(5)
         # create our new Enum type
         enum_class = super().__new__(metacls, cls, bases, classdict)
+        
         enum_class._member_names_ = []               # names in definition order
         enum_class._member_map_ = OrderedDict()      # name->value map
         enum_class._member_type_ = member_type
-
+        pk(6)
         # 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.
         enum_class._value2member_map_ = {}
-
+        pk(7)
         # If a custom type is mixed into the Enum, and it does not know how
         # to pickle itself, pickle.dumps will succeed but pickle.loads will
         # fail.  Rather than have the error show up later and possibly far
@@ -180,7 +188,7 @@ class EnumMeta(type):
                         '__reduce_ex__', '__reduce__')
                 if not any(m in member_type.__dict__ for m in methods):
                     _make_class_unpicklable(enum_class)
-
+        pk(8)
         # instantiate them, checking for duplicates as we go
         # we instantiate first instead of checking for duplicates first in case
         # a custom __new__ is doing something funky with the values -- such as
@@ -230,7 +238,7 @@ class EnumMeta(type):
                 enum_class._value2member_map_[value] = enum_member
             except TypeError:
                 pass
-
+        pk(9)
         # double check that repr and friends are not the mixin's or various
         # things break (such as pickle)
         for name in ('__repr__', '__str__', '__format__', '__reduce_ex__'):
@@ -239,7 +247,7 @@ class EnumMeta(type):
             enum_method = getattr(first_enum, name, None)
             if obj_method is not None and obj_method is class_method:
                 setattr(enum_class, name, enum_method)
-
+        pk(10)
         # replace any other __new__ with our own (as long as Enum is not None,
         # anyway) -- again, this is to support pickle
         if Enum is not None:
@@ -248,14 +256,14 @@ class EnumMeta(type):
             if save_new:
                 enum_class.__new_member__ = __new__
             enum_class.__new__ = Enum.__new__
-
+        pk(11)
         # py3 support for definition order (helps keep py2/py3 code in sync)
         if _order_ is not None:
             if isinstance(_order_, str):
                 _order_ = _order_.replace(',', ' ').split()
             if _order_ != enum_class._member_names_:
                 raise TypeError('member order does not match _order_')
-
+        pk(12)
         return enum_class
 
     def __bool__(self):
@@ -424,9 +432,10 @@ class EnumMeta(type):
         bases: the tuple of bases that was given to __new__
 
         """
+        pk('bases',bases)
         if not bases:
             return object, Enum
-
+        pk(2)
         # double check that we are not subclassing a class with existing
         # enumeration members; while we're at it, see if any other data
         # type has been mixed in so we can use the correct __new__
@@ -436,6 +445,9 @@ class EnumMeta(type):
                     issubclass(base, Enum) and
                     base._member_names_):
                 raise TypeError("Cannot extend enumerations")
+        pk(3)
+        pk(base)
+        pk(bases)
         # base is now the last base in bases
         if not issubclass(base, Enum):
             raise TypeError("new enumerations must be created as "
@@ -473,11 +485,12 @@ class EnumMeta(type):
         # now find the correct __new__, checking to see of one was defined
         # by the user; also check earlier enum classes in case a __new__ was
         # saved as __new_member__
+        pk(0)
         __new__ = classdict.get('__new__', None)
-
+        pk(1)
         # should __new__ be saved as __new_member__ later?
         save_new = __new__ is not None
-
+        pk(2)
         if __new__ is None:
             # check all possibles for __new_member__ before falling back to
             # __new__
@@ -496,7 +509,7 @@ class EnumMeta(type):
                     break
             else:
                 __new__ = object.__new__
-
+        pk(3)
         # if a non-object.__new__ is used then whatever value/tuple was
         # assigned to the enum member name will be passed to __new__ and to the
         # new enum member's __init__
@@ -504,7 +517,7 @@ class EnumMeta(type):
             use_args = False
         else:
             use_args = True
-
+        pk(4)
         return __new__, save_new, use_args
 
 class Enum(metaclass=EnumMeta):
@@ -636,6 +649,7 @@ class Enum(metaclass=EnumMeta):
         module_globals[name] = cls
         return cls
 
+pk(6)
 
 class IntEnum(int, Enum):
     """Enum where members are also (and must be) ints"""
index 3398dbb589158ecef079e3619b7da496aa4e108e..ef42cc6a63ec00612376a2574c8773ac80e66b48 100644 (file)
@@ -29,7 +29,7 @@
   #:use-module (language python eval             )
   #:use-module (language python bool             )
 
-  #:replace (list abs min max hash round format)
+  #:replace (list abs min max hash round format map)
   
   #:re-export (StopIteration GeneratorExit RuntimeError
                              Exception ValueError TypeError
@@ -47,7 +47,7 @@
                   chr classmethod staticmethod objectmethod
                   divmod enumerate filter
                   getattr hasattr setattr hex isinstance issubclass
-                  iter map sum id input oct ord pow super
+                  iter sum id input oct ord pow super
                   sorted zip
                  ClassMethod StaticMethod Funcobj))
 
index 6d93435f04cb7f14b2accdb8e5381c7223745151..845a1558771d4b09dbd7369115f0a6a3aa92870c 100644 (file)
@@ -74,7 +74,7 @@
 (define-syntax-rule (mk-biop1 mk-biop0 op r1)
   (begin
     (mk-biop0 op)
-    (define-method (op v (o <p>))
+    (define-method (op (o <p>) v)
       (aif it (ref o 'r1)
            (it v)
            (next-method)))))
@@ -95,6 +95,7 @@
     (define-method (op o2 (o1 <py-int>))
       (op o2 (slot-ref o1 'x)))))
 
+      
 (mk-biop2 b0 r+ + __add__ __radd__)
 (mk-biop2 b0 r- - __sub__ __rsub__)
 (mk-biop2 b0 r* * __mul__ __rmul__)
 (mk-biop2 b0 rexpt expt __pow__ __rpow__)
 (b0 py-equal?)
 
+
 (define-method (py-lshift (o1 <integer>) (o2 <integer>))
   (ash o1 o2))
 (define-method (py-rshift (o1 <integer>) (o2 <integer>))
 (define-method (py-lognot (o1 <integer>))
   (lognot o1))
 
+(define-method (py-logand o1 (o2 <py-int>))
+  (py-logand o1 (slot-ref o2 'x)))
+
+(define-method (py-logand (o1 <py-int>) o2)
+  (py-logand (slot-ref o1 'x) o2))
+
+(define-method (py-logior o1 (o2 <py-int>))
+  (py-logior o1 (slot-ref o2 'x)))
+
+(define-method (py-logior (o1 <py-int>) o2)
+  (py-logior (slot-ref o1 'x) o2))
+
+(define-method (py-logxor o1 (o2 <py-int>))
+  (py-logxor o1 (slot-ref o2 'x)))
+
+(define-method (py-logxor (o1 <py-int>) o2)
+  (py-logxor (slot-ref o1 'x) o2))
+
+(define-method (py-lognot (o1 <py-int>))
+  (lognot (slot-ref o1 'x)))
+
+(define-method (py-logand (o1 <p>) o2)
+  (aif it (ref o1 '__and__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-logand o1 (o2 <p>))
+  (aif it (ref o1 '__rand__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-logior (o1 <p>) o2)
+  (aif it (ref o1 '__or__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-logior o1 (o2 <p>))
+  (aif it (ref o1 '__ror__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-logxor (o1 <p>) o2)
+  (aif it (ref o1 '__xor__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-logxor o1 (o2 <p>))
+  (aif it (ref o1 '__rxor__)
+       (it o2)
+       (next-method)))
+
+(define-method (py-lognot (o1 <p>))
+  (aif it (ref o1 '__not__)
+       (it)
+       (next-method)))
+
 
 (define-method (py-/ (o1 <number>) (o2 <integer>))
   (/ o1 (exact->inexact o2)))
index 5582d36b1e0e45f59e9887f8cddb241c51b15610..2f3b7cc1e9169436c494c16370c44eb3d3d68975 100644 (file)
              (t (slot-ref d    't)))
         (not (eq? miss (py-hash-ref t x miss))))))
 
+  (define __and__
+    (lambda (self op)
+      (intersection self op)))
+
+  (define __or__
+    (lambda (self op)
+      (union self op)))
+
+  (define __sub__
+    (lambda (self op)
+      (difference self op)))
+
+  (define __xor__
+    (lambda (self op)
+      (symmetric_difference self op)))
+  
   (define __eq__
     (lambda (self x)
       (and
index d42865f2d7dc283172d6c302f3fa0b01718e0461..64ad776f74d57cb51def1d67c5b0ea72e32e1342 100644 (file)
@@ -17,7 +17,7 @@
                 py-super-mac py-super py-equal? 
                 *class* *self* pyobject? pytype?
                 type object pylist-set! pylist-ref tr
-               resolve-method-g rawref rawset
+               resolve-method-g rawref rawset py-dict
                 ))
 
 #|
@@ -34,6 +34,26 @@ The datastructure is functional but the objects mutate. So one need to
 explicitly tell it to not update etc.
 |#
 
+(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) (pk k)) h)
+    (pk 'finished-obj)
+    (aif cl (hash-ref h '__class__)
+         (if (is-a? cl <p>)
+             (if (hash-table? (slot-ref cl 'h))
+                 (hash-for-each (lambda (k v)
+                                  (if (member k '(__name__ __qualname__))
+                                      (pk k v)
+                                      (pk k)))
+                                (slot-ref cl 'h))
+                 (pk 'no-hash-table))
+             (pk 'no-class))
+         (pk 'false-class)))
+  (pk 'end-pk-obj))
+
 (define fail (cons 'fail '()))
 
 (define-syntax-rule (kif it p x y)
@@ -52,7 +72,6 @@ explicitly tell it to not update etc.
 
 (define (is-acl? a b) (member a (cons b (class-subclasses b))))
 
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 (define-class <p>  (<applicable-struct> <object>) h)
 (define-class <pf> (<p>) size n)         ; the pf object consist of a functional
                                          ; hashmap it's size and number of live
@@ -88,6 +107,27 @@ 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 (klass <pf>) key fail)
+  (let ((r (vhash-assoc key (slot-ref klass 'h))))
+    (if r
+       (cdr r)
+       fail)))
+
+(define-syntax-rule (find-in-class-and-parents klass key fail-)
+  (aif parents (find-in-class klass '__mro__ #f)
+       (let lp ((parents parents))
+         (if (pair? parents)
+             (kif r (find-in-class (car parents) key fail)
+                  r
+                  (lp (cdr parents)))
+             fail-))
+       (kif r (find-in-class klass key fail)
+            r
+            fail-)))
+
+(define-inlinable
+  (ficap klass key fail) (find-in-class-and-parents klass key fail))
+
 (define (mk-getter-object f)
   (lambda (obj cls)
     (if (pytype? obj)
@@ -95,10 +135,10 @@ explicitly tell it to not update etc.
         (if (pyclass? obj)
             (if (pytype? cls)                
                 (lambda x (apply f obj x))
-                (lambda x (apply f x)))
+                f)
             (if (pyclass? cls)
                 (lambda x (apply f obj x))
-                (lambda x (apply f x)))))))
+                f)))))
 
 (define (mk-getter-class f)                                   
   (lambda (obj cls)
@@ -158,20 +198,17 @@ explicitly tell it to not update etc.
 (define (resolve-method-o o pattern)
   (resolve-method-g (class-of o) pattern))
   
-(define (get-dict self name parents)
-  (aif it (ref self '__prepare__)
-       (it self name parents)
-       (make-hash-table)))
-
 (define (hashforeach a b) (values))
 
 (define (new-class0 meta name parents dict . kw)
   (let* ((goops (pylist-ref dict '__goops__))
-        (p     (kwclass->class kw meta))
+        (p     (kwclass->class kw meta))         
         (class (make-p p)))
+    (pk 'new-class0)
     (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))
@@ -194,7 +231,7 @@ explicitly tell it to not update etc.
     class))
 
 (define (new-class meta name parents dict kw)
-  (aif it (ref meta '__new__)
+  (aif it (and meta (ficap meta '__new__ #f))
        (apply it meta name parents dict kw)
        (apply new-class0 meta name parents dict kw)))
 
@@ -205,31 +242,55 @@ explicitly tell it to not update etc.
          #f)
     class))
 
-(define (create-class meta name parents gen-methods . keys)
-  (let ((dict (gen-methods (get-dict meta name keys))))
+
+(define (the-create-object class x)
+  (let* ((meta  (ref class '__class__))
+         (goops (ref class '__goops__))
+         (obj   (aif it (ficap class '__new__ #f)
+                     (it)
+                     (make-object class meta goops))))
+    (aif it (ref obj '__init__)
+         (apply it x)
+         #f)
+
+    (slot-set! obj 'procedure
+               (lambda x
+                 (aif it (ref obj '__call__)
+                      (apply it x)
+                      (error "not a callable object"))))
+
+    obj))
+
+(define (create-object class meta goops x)
+  (with-fluids ((*make-class* #t))
+    (aif it (ficap meta '__call__ #f)
+         (apply it class x)
+         (the-create-object class x))))
+
+(define type-call
+  (lambda (class . l)
+    (if (pytype? class)
+        (apply (case-lambda
+                 ((meta obj)
+                  (ref obj '__class__ 'None))
+                 ((meta name bases dict . keys)
+                  (type- meta name bases dict keys)))
+               class l)
+        (the-create-object class l))))
+
+(define (get-dict self name parents)
+  (aif it (and self (ficap self '__prepare__ #f))
+       (it self name parents)
+       (make-hash-table)))
+
+(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 (find-in-class (ref meta '__class__) '__call__ #f)
+         (aif it (find-in-class it '__call__ #f)
               (apply it meta name parents dict keys)
               (type- meta name parents dict keys))
          (type- meta name parents dict keys))))
 
-(define (create-object class meta goops x)
-  (with-fluids ((*make-class* #t))
-    (aif it #f
-       (apply it x)       
-       (let ((obj (aif it (find-in-class class '__new__ #f)
-                       (it)
-                       (make-object class meta goops))))
-         (aif it (ref obj '__init__)
-              (apply it x)
-              #f)
-         (slot-set! obj 'procedure
-                    (lambda x
-                      (aif it (ref obj '__call__)
-                           (apply it x)
-                           (error "not a callable object"))))
-         obj))))
-
 (define (make-object class meta goops)
   (let ((obj (make-p goops)))
     (set obj '__class__ class)
@@ -272,6 +333,11 @@ explicitly tell it to not update etc.
         (f obj class)
         it)))
 
+(define-inlinable (gokx obj class it)
+  (aif f (rawref it '__get__)
+       (f obj class)
+       it))
+
 (define *location* (make-fluid #f))
 (define-syntax-rule (mrefx x key l)
   (let ()
@@ -304,30 +370,12 @@ explicitly tell it to not update etc.
 
 (define-method (find-in-class (klass <p>) key fail)
   (hash-ref (slot-ref klass 'h) key fail))
-
-(define-method (find-in-class (klass <pf>) key fail)
-  (let ((r (vhash-assoc key (slot-ref klass 'h))))
-    (if r
-       (cdr r)
-       fail)))
-
-(define-syntax-rule (find-in-class-and-parents klass key fail)
-  (kif r (find-in-class klass key fail)
-       r
-       (aif parents (find-in-class klass '__mro__ #f)
-           (let lp ((parents (cdr parents)))
-             (if (pair? parents)
-                 (kif r (find-in-class (car parents) key fail)
-                      r
-                      (lp (cdr parents)))
-                 fail))
-           fail)))
-
+  
 (define-syntax-rule (mrefx klass key l)
   (let ()
     (define (end) (if (pair? l) (car l) #f))    
     (fluid-set! *location* klass)
-    (kif it (find-in-class klass key fail)
+    (kif it (find-in-class-and-parents klass key fail)
         it
         (aif klass (find-in-class klass '__class__ #f)
              (begin
@@ -341,26 +389,17 @@ explicitly tell it to not update etc.
 
 (define-syntax-rule (mrefx-py x key l)
   (let ((xx x))
-     (let* ((g (mrefx xx '__fget__ '(#t)))
-           (f (if g
-                  (if (eq? g #t)
-                      (aif it (mrefx xx '__getattribute__ '())
-                           (let ((f (gox xx it)))
-                             (rawset xx '__fget__ it)
-                             f)                            
-                           (begin
-                             (if (mc?)
-                                 (rawset xx '__fget__ #f))
-                             #f))
-                      g)
-                  #f)))
-       (if (or (not f) (eq? f not-implemented))
-          (gox xx (mrefx xx key l))
-          (catch #t
-                 (lambda ()
-                   (f xx key))
-                 (lambda x
-                   (gox xx (mrefx xx key l))))))))
+    (let* ((f (aif it (or (mrefx xx '__getattribute__ '())
+                          (mrefx xx '__getattr__ '()))
+                   (gox xx it)
+                   #f)))
+      (if (or (not f) (eq? f not-implemented))
+          (gox xx (mrefx xx key l))
+          (catch #t
+            (lambda ()
+              (f xx key))
+            (lambda x
+              (gox xx (mrefx xx key l))))))))
 
 
 (define-syntax-rule (mref x key l)
@@ -372,7 +411,15 @@ explicitly tell it to not update etc.
     (let ((res (mrefx-py xx key l)))
       res)))
 
-(define-method (ref x key . l) (if (pair? l) (car l) #f))
+(define-method (ref x key . l)
+  (cond
+   ((eq? x 'None)
+    (apply ref NoneObj key l))
+   ((pair? l)
+    (car l))
+   (else
+    #f)))
+
 (define-method (ref (x <pf> )  key . l) (mref     x key l))
 (define-method (ref (x <p>  )  key . l) (mref     x key l))
 (define-method (ref (x <pyf>)  key . l) (mref-py  x key l))
@@ -712,28 +759,32 @@ explicitly tell it to not update etc.
    ((name supers.kw methods)
     (make-p-class name "" supers.kw methods))
    ((name doc supers.kw methods)
-    (define kw      (cdr supers.kw))
-    (define supers  (car supers.kw))
+    (define s.kw    supers.kw)
+    (define kw      (cdr s.kw))
+    (define supers  (car s.kw))
     (define goopses (map (lambda (sups)
                           (aif it (ref sups '__goops__ #f)
                                it
                                sups))
                         supers))
+    
     (define parents (let ((p (filter-parents supers)))
-                     (if (null? p)
-                         (if object
-                             (list object)
-                             '())
-                         p)))
+                      p))
+    
+    (define cparents (if (null? parents)
+                         (if object
+                             (list object)
+                             '())
+                         parents))
     
     (define meta (aif it (memq #:metaclass kw)
                      (cadr it)
-                     (if (null? parents)
+                     (if (null? cparents)
                          type
-                         (let* ((p   (car parents))
+                         (let* ((p   (car cparents))
                                 (m   (ref p '__class__))
                                 (mro (reverse (ref m '__mro__ '()))))
-                           (let lp ((l   (cdr parents))
+                           (let lp ((l   (cdr cparents))
                                     (max mro)
                                     (min mro))
                              (if (pair? l)
@@ -753,7 +804,8 @@ explicitly tell it to not update etc.
                                              (lp (cdr l) mro min)))))
                                  (car (reverse min))))))))
   
-    (define goops (make-class (append goopses (list (kw->class kw meta)))
+    (define goops (make-class (append goopses
+                                      (list (kw->class kw meta)))
                              '() #:name name))
 
     (define (make-module)
@@ -766,33 +818,42 @@ explicitly tell it to not update etc.
             (map symbol->string (cdddr l))
             ".")
            l)))
-  
+    
     (define (gen-methods dict)
+      (define (filt-bases x)
+        (let lp ((x x))
+          (if (pair? x)
+              (let ((y (car x)))
+                (if (is-a? y <p>)
+                    (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))
       (pylist-set! dict '__module__   (make-module))
-      (pylist-set! dict '__bases__    parents)
+      (pylist-set! dict '__bases__    (filt-bases parents))
       (pylist-set! dict '__fget__     #t)
       (pylist-set! dict '__fset__     #t)
       (pylist-set! dict '__name__     name)
       (pylist-set! dict '__qualname__ name)
       (pylist-set! dict '__class__    meta)
-      (pylist-set! dict '__mro__      (get-mro parents))
+      (pylist-set! dict '__mro__      (get-mro cparents))
       (pylist-set! dict '__doc__      doc)
       dict)
 
     (let ((cl (with-fluids ((*make-class* #t))
-                          (create-class meta name parents gen-methods kw))))
+                (create-class meta name parents gen-methods kw))))
       (aif it (ref meta '__init_subclass__)
-          (let lp ((ps parents))
+          (let lp ((ps cparents))
             (if (pair? ps)
                 (let ((super (car ps)))
                   (it cl super)
                   (lp (cdr ps)))))
           #f)
-    
+      
       cl))))
                    
 
@@ -867,8 +928,8 @@ explicitly tell it to not update etc.
   (lambda (x)
     (syntax-case x ()
       ((_ name parents ((ddef dname dval) ...) body)
-       #'(mk-p-class name parents "" (ddef dname dval) ...))
-      ((_ name parents doc (ddef dname dval) ...)
+       #'(mk-p-class2 name parents "" ((ddef dname dval) ...) body))
+      ((_ name parents doc ((ddef dname dval) ...) body)
        (with-syntax (((ddname ...)
                      (map (lambda (dn)
                             (datum->syntax
@@ -894,13 +955,13 @@ explicitly tell it to not update etc.
        #'(let ()
            (define name 
              (letruc ((dname (make-up dval)) ...)
-                     body
-                    (make-p-class 'name doc
-                                   parents
-                                   (lambda (dict)
-                                     (pylist-set! dict 'dname dname)
-                                     ...
-                                     (values)))))
+                 body
+                 (make-p-class 'name doc
+                               parents
+                               (lambda (dict)
+                                 (pylist-set! dict 'dname dname)
+                                 ...
+                                 (values)))))
 
            (begin
              (module-define! (current-module) 'ddname (ref name 'dname))
@@ -1001,11 +1062,15 @@ explicitly tell it to not update etc.
                                 code ...)))
           cl)))))
     
-
+(define type-goops #f)
 (define (kind x)
+  (if (not type-goops) (set! type-goops (ref type '__goops__)))      
   (and (is-a? x <p>)
        (aif it (find-in-class x '__goops__ #f)
-            (if (is-a? (make it) (ref type '__goops__))
+            (if (or
+                 (not type-goops)
+                 (eq? it type-goops)
+                 (member it (class-subclasses type-goops)))
                 'type
                 'class)
             'object)))
@@ -1028,25 +1093,23 @@ explicitly tell it to not update etc.
 (define (not-a-super) 'not-a-super)
 (define (py-super class obj)
   (define (make cl parents)
-    (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)))
+    (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__ (lambda (self key . l)
+                                         (aif it (ficap c key #f)
+                                              (if (procedure? it)
+                                                  (gokx obj cl it)
+                                                  it)
+                                              (error "no attribute"))))
+              (set c '__name__  "**super**")
+              (set o '__class__ c)
+              o))))
   
   (call-with-values
       (lambda ()
@@ -1222,17 +1285,16 @@ explicitly tell it to not update etc.
        (define __init_subclass__ (lambda x (values)))
        (define ___zub_classes__  (make-weak-key-hash-table))
        (define __subclasses__    subclasses)
-        (define __call__
-          (case-lambda
-          ((meta obj)
-           (ref obj '__class__ 'None))
-          ((meta name bases dict . keys)
-           (type- meta name bases dict keys))))))
+        (define __call__          type-call)
+        (define mro               (lambda (self) (ref self '__mro__)))))
+
 (set type '__class__ type)
 
 (set! object (make-python-class object ()
-                               (define __subclasses__ subclasses)
-                               (define __weakref__   (lambda (self) self))))
+               (define __init__       (lambda x (values)))
+               (define __subclasses__ subclasses)
+               (define __weakref__    (lambda (self) self))))
+               
 
 (name-object type)
 (name-object object)
@@ -1242,4 +1304,14 @@ explicitly tell it to not update etc.
        it
        (next-method)))
 
-       
+
+(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)))
+
+