diff options
Diffstat (limited to 'modules/oop/pf-objects.scm')
| -rw-r--r-- | modules/oop/pf-objects.scm | 65 |
1 files changed, 31 insertions, 34 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 9ebce3f..479c035 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -210,7 +210,6 @@ explicitly tell it to not update etc. (define (new-class0 meta name parents dict . kw) - (pk 'new-class0) (let* ((goops (pylist-ref dict '__goops__)) (p (kwclass->class kw meta)) (class (make-p p))) @@ -241,26 +240,23 @@ explicitly tell it to not update etc. class)) (define (new-class meta name parents dict kw) - (pk 'new-class) (aif it (and meta (ficap meta '__new__ #f)) (apply it meta name parents dict kw) (apply new-class0 meta name parents dict kw))) (define (type- meta name parents dict keys) - (pk 'type-) (let ((class (new-class meta name parents dict keys))) - (aif it (and meta (find-in-class meta '__init__ #f)) + (aif it (and meta (find-in-class-and-parents meta '__init__ #f)) (it class name parents dict keys) #f) - class)) + (pk 'res class))) (define (the-create-object class x) - (pk 'the-create-object) (let* ((meta (ref class '__class__)) (goops (ref class '__goops__)) - (obj (aif it (pk '__new__ (ficap class '__new__ #f)) - (begin (pk-obj class) (apply it class x)) + (obj (aif it (ficap class '__new__ #f) + (apply it class x) (make-object class meta goops)))) (aif it (ref obj '__init__) @@ -276,8 +272,7 @@ explicitly tell it to not update etc. obj)) (define (create-object class x) - (pk 'create-object) - (if (pk 'type? (pytype? class)) + (if (pytype? class) (apply type-call class x) (let ((meta (find-in-class class '__class__ #f))) (with-fluids ((*make-class* #t)) @@ -287,8 +282,7 @@ explicitly tell it to not update etc. (define type-call (lambda (class . l) - (pk 'type-call) - (if (pk 'type? (pytype? class)) + (if (pytype? class) (apply (case-lambda ((meta obj) (ref obj '__class__ 'None)) @@ -303,7 +297,6 @@ explicitly tell it to not update etc. (make-hash-table))) (define (create-class meta name parents gen-methods keys) - (pk 'create-class) (let ((dict (gen-methods (get-dict meta name parents)))) (aif it (ref meta '__class__) (aif it (find-in-class it '__call__ #f) @@ -312,7 +305,6 @@ explicitly tell it to not update etc. (type- meta name parents dict keys)))) (define (make-object class meta goops) - (pk 'make-object) (let ((obj (make-p goops))) (set obj '__class__ class) obj)) @@ -867,6 +859,7 @@ explicitly tell it to not update etc. (let ((cl (with-fluids ((*make-class* #t)) (create-class meta name parents gen-methods kw)))) + (pk 'got cl) (aif it (ref meta '__init_subclass__) (let lp ((ps cparents)) (if (pair? ps) @@ -874,7 +867,7 @@ explicitly tell it to not update etc. (it cl super) (lp (cdr ps))))) #f) - + (pk 'return) cl)))) @@ -976,22 +969,26 @@ explicitly tell it to not update etc. #'(let () (define name (letruc ((dname (make-up dval)) ...) - body - (make-p-class 'name doc - parents - (lambda (dict) - (pylist-set! dict 'dname dname) - ... - (values))))) - + body + (make-p-class 'name doc + parents + (lambda (dict) + (pylist-set! dict 'dname dname) + ... + (values))))) + + (pk 1) (begin + (pk 'ddname 'dname) (module-define! (current-module) 'ddname (ref name 'dname)) + (pk '*) (name-object ddname)) ... - + (pk 2) (module-define! (current-module) 'nname (ref name '__goops__)) (name-object nname) (name-object name) + (pk 3) name)))))) (define-syntax mk-p-class-noname @@ -1301,20 +1298,20 @@ explicitly tell it to not update etc. '())) (set! type - (make-python-class type () - (define __new__ new-class0) - (define __init_subclass__ (lambda x (values))) - (define ___zub_classes__ (make-weak-key-hash-table)) - (define __subclasses__ subclasses) - (define __call__ type-call) - (define mro (lambda (self) (ref self '__mro__))))) + (make-python-class type () + (define __new__ new-class0) + (define __init_subclass__ (lambda x (values))) + (define ___zub_classes__ (make-weak-key-hash-table)) + (define __subclasses__ subclasses) + (define __call__ type-call) + (define mro (lambda (self) (ref self '__mro__))))) (set type '__class__ type) (set! object (make-python-class object () - (define __init__ (lambda x (values))) - (define __subclasses__ subclasses) - (define __weakref__ (lambda (self) self)))) + (define __init__ (lambda x (values))) + (define __subclasses__ subclasses) + (define __weakref__ (lambda (self) self)))) (name-object type) |