diff options
Diffstat (limited to 'modules/oop/pf-objects.scm')
| -rw-r--r-- | modules/oop/pf-objects.scm | 21 |
1 files changed, 10 insertions, 11 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 655f49c..15bbd2f 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -96,9 +96,7 @@ explicitly tell it to not update etc. (define (mk-getter-class f) (lambda (obj cls) - (if (eq? obj cls) - (lambda x (apply f x)) - (lambda x (apply f cls x))))) + (lambda x (apply f cls x)))) (define (class-method f) (set f '__get__ (mk-getter-class f))) @@ -298,28 +296,29 @@ explicitly tell it to not update etc. (define-syntax-rule (find-in-class-and-parents klass key fail) (kif r (find-in-class klass key fail) - (begin (fluid-set! *location* klass) r) + r (aif parents (find-in-class klass '__mro__ #f) (let lp ((parents parents)) (if (pair? parents) (kif r (find-in-class (car parents) key fail) - (begin (fluid-set! *location* (car parents)) r) + r (lp (cdr parents))) fail)) fail))) (define-syntax-rule (mrefx klass key l) (let () - (define (end) (if (pair? l) (car l) #f)) + (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 - (begin - (aif klass (find-in-class klass '__class__ #f) + (aif klass (find-in-class klass '__class__ #f) + (begin + (fluid-set! *location* klass) (kif it (find-in-class-and-parents klass key fail) it - (end)) - (end)))))) + (end))) + (end))))) (define not-implemented (cons 'not 'implemeneted)) |