diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-08-28 20:22:54 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-08-28 20:22:54 +0200 |
commit | 9bd339b34f09f5b582cb8b77a11841f5de9ab695 (patch) | |
tree | 90cd1b58cc720333c76acec8ae305995e14b97cf /modules/oop | |
parent | b50c95c519c2b1f72badabf608c038e91d788213 (diff) |
random works
Diffstat (limited to 'modules/oop')
-rw-r--r-- | modules/oop/pf-objects.scm | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index f5b6466..fd11182 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -171,6 +171,7 @@ explicitly tell it to not update etc. (hash-ref h key -fail)))) (define-method (find-in-class x key fail) fail) +(define-method (find-in-class-raw klass key fail) fail) (define-method (find-in-class-raw (klass <pf>) key fail) (let ((r (vhash-assoc key (slot-ref klass 'h)))) @@ -519,6 +520,30 @@ explicitly tell it to not update etc. (apply it class x) (the-create-object class x)))))) +(define int-cls #f) +(define int? #f) +(define tuple-cls #f) +(define tuple? #f) +(define string-cls #f) +(define str? #f) +(define bytes-cls #f) +(define bytes? #f) +(define list-cls #f) +(define list? #f) +(define float-cls #f) +(define float? #f) + +(define (check-obj obj) + (cond + ((int? obj) int-cls) + ((tuple? obj) tuple-cls) + ((float? obj) float-cls) + ((str? obj) string-cls) + ((list? obj) list-cls) + ((bytes? obj) bytes-cls) + (else + object))) + (define type-call (lambda (class . l) (if (pytype? class) @@ -528,11 +553,11 @@ explicitly tell it to not update etc. (lambda () (aif it (find-in-class-raw obj '__class__ #f) it - type)) + (check-obj obj))) (lambda x (warn x) - type))) - + (check-obj obj)))) + ((meta name bases dict . keys) (type- meta name bases dict keys))) class l) |