improved class handling

1 files changed, 11 insertions, 3 deletions

diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 0c54bd4..ecb94f6 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -90,7 +90,7 @@ explicitly tell it to not update etc.
                          (let ((parent (car parents)))
                            (let ((r (lp (slot-ref parent 'h))))
                              (if (eq? r fail)
-                                 (lp (cdr parents))
+                                 (lpp (cdr parents))
                                  r)))
                          fail))
                    fail)
@@ -136,7 +136,14 @@ explicitly tell it to not update etc.
 (define-method (ref (x <p>  )  key . l) (mref-    x key l))
 (define-method (ref (x <pyf>)  key . l) (mref-py  x key l))
 (define-method (ref (x <py> )  key . l) (mref-py- x key l))
-
+(define-method (ref x key . l)
+  (define (end)   (if (pair? l) (car l) #f))
+  (if (procedure? x)
+      (aif it (procedure-property x 'pyclass)
+           (apply ref it key l)
+           (end))
+      (end)))
+      
 
 
 ;; the reshape function that will create a fresh new pf object with less size
@@ -459,7 +466,8 @@ explicitly tell it to not update etc.
                                           #'(supers (... ...)))))
            #'(let ((sups supers) (... ...))
                (define class dynamic)
-               (define name (make-class (list sups (... ...) <p>) '()))
+               (define name (make-class (list (ref sups '__goops__ #f)
+                                              (... ...) <p>) '()))
                
                (set! class
                  (union- const