From 5df2484c4a2fe0cc778fc008230d3f52c6b082df Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Wed, 13 Sep 2017 21:06:02 +0200 Subject: proper compiling of class variables --- modules/oop/pf-objects.scm | 36 ++++++++++++++++++++++++++++++++---- 1 file changed, 32 insertions(+), 4 deletions(-) (limited to 'modules') 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__ '()))) -- cgit v1.2.3