diff options
| author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-05 17:32:09 +0200 |
|---|---|---|
| committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-05 17:32:09 +0200 |
| commit | ecd0540ef80b46c2e1a76268d6f8ca2801189d02 (patch) | |
| tree | 1a85b8df0016e14eba725b8ee457580dc309512f /modules/oop | |
| parent | ad5e33eba9b1274251ff79db2f4127db430fab3e (diff) | |
super trouper
Diffstat (limited to 'modules/oop')
| -rw-r--r-- | modules/oop/pf-objects.scm | 45 |
1 files changed, 13 insertions, 32 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 3508d16..ebaa3b7 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -144,7 +144,7 @@ explicitly tell it to not update etc. (if (pair? parents) (let ((parent (car parents))) (let* ((h (slot-ref parent 'h)) - (r (hash-ref class-h key fail))) + (r (hash-ref h key fail))) (if (eq? r fail) (lpp (cdr parents)) r))) @@ -722,12 +722,13 @@ explicitly tell it to not update etc. (define *super* (list 'super)) +(define (not-a-super) 'not-a-super) (define (py-super class obj) (define (make cl parents) (let ((c (make-p)) (o (make-p))) (set c '__super__ #t) - (set c '__parents__ parents) + (set c '__mro__ parents) (set c '__getattribute__ (lambda (self key . l) (aif it (ref c key) (if (procedure? it) @@ -744,31 +745,15 @@ explicitly tell it to not update etc. (call-with-values (lambda () - (let lp ((c (ref obj '__class__))) - (if (eq? class c) - (let ((p (ref c '__parents__))) - (if (pair? p) - (values (car p) p) - (values #t #t))) - (let lp2 ((p (ref c 'parents))) - (if (pair? p) - (call-with-values (lambda () (lp (car p))) - (lambda (c ps) - (cond - ((eq? c #t) - (if (pair? p) - (let ((x (car p))) - (values - x - (append - (ref x '__parents__) - (cdr p)))) - (values #t #t))) - (c - (values c (append ps (cdr p)))) - (else - (lp2 (cdr p)))))) - (values #f #f)))))) + (let lp ((l (ref (ref obj '__class__) '__mro__ '()))) + (if (pair? l) + (if (eq? class (car l)) + (let ((r (cdr l))) + (if (pair? r) + (values (car r) r) + (values #f #f))) + (lp (cdr l))) + (values #f #f)))) make)) @@ -870,11 +855,7 @@ explicitly tell it to not update etc. (if tree (let ((x (tree-ref tree)) (n (nxt tree))) - (if (pk 'find (find-tree x n)) + (if (find-tree x n) (lp n r) (lp n (cons x r)))) (reverse r)))) - - - - |