proper compiling of class variables

1 files changed, 32 insertions, 4 deletions

diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 515af74..ca9a11b 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -99,7 +99,8 @@ explicitly tell it to not update etc.
                         (end)))
               (end)))))
 
-(define-syntax-rule (mrefx- x key l)
+(define-syntax-rule (mrefx- x key l) (mrefx-- (slot-ref x 'h) key l))
+(define-syntax-rule (mrefx-- hi key l)
   (let ()
     (define (end)   (if (pair? l) (car l) #f))
     (define (ret q) (if (eq? q fail) (end) q))
@@ -120,7 +121,7 @@ explicitly tell it to not update etc.
                    fail)
               r))))
 
-    (let* ((h (slot-ref x 'h))
+    (let* ((h hi)
            (r (hash-ref h key fail)))
       (if (eq? r fail)
           (aif class (hash-ref h '__class__)
@@ -211,9 +212,36 @@ explicitly tell it to not update etc.
         (mset x key val)
         (f key val))))
 
+(define (pkh h) (hash-for-each (lambda x (pk x)) h) h)
+
 (define-syntax-rule (mset- x key val)
-  (let ((h (slot-ref x 'h)))
-    (hash-set! h key val)))
+  (let ()
+    (define (s h) (begin (hash-set! h key val) #f))
+    (define fret #t)
+    (define (r h k) (hash-ref h k))
+    (define-syntax-rule (ifh h fail-code)
+      (if (r h key)
+          (s h)
+          fail-code))
+          
+    (define (hm x) (slot-ref x 'h))
+    (let ((h (hm x)))
+      (if (ifh h
+               (aif it (r h '__class__)
+                    (let lp ((cl it))
+                      (let ((h (hm cl)))
+                        (ifh h
+                             (aif it (r h '__parents__)
+                                  (let lp2 ((parents it))
+                                    (if (pair? parents)
+                                        (if (lp (car parents))
+                                            (lp2 (cdr parents))
+                                            fret)
+                                        fret))
+                                  fret))))
+                    fret))
+          (s h))
+      (values))))
 
 (define-syntax-rule (mset-py- x key val)
   (let ((f (mref-py- x '__set__ '())))