diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-03 21:44:56 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-03 21:44:56 +0200 |
commit | 98f11c126a243596efe83fffa6af09b262ecaeac (patch) | |
tree | b371b8440c6bb523ffcbec2165ce8486b7181c75 /modules/oop/pf-objects.scm | |
parent | 3533d6037dd7d83a1f9ee250138d0ebf1bccc062 (diff) |
decorators works
Diffstat (limited to 'modules/oop/pf-objects.scm')
-rw-r--r-- | modules/oop/pf-objects.scm | 38 |
1 files changed, 34 insertions, 4 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 5937d37..d916fe8 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -10,6 +10,7 @@ def-pyf-class mk-pyf-class make-pyf-class def-py-class mk-py-class make-py-class define-python-class get-type py-class + object-method class-method static-method )) #| Python object system is basically syntactic suger otop of a hashmap and one @@ -178,8 +179,7 @@ explicitly tell it to not update etc. (let ((xx x)) (let ((res (mrefx- xx key l))) (if (and (not (struct? res)) (procedure? res)) - (lambda z - (apply res xx z)) + (res xx) res))))) (unx mrefx- mref-) @@ -194,8 +194,7 @@ explicitly tell it to not update etc. (if (and (not (struct? res)) (not (pyclass? res)) (procedure? res)) - (lambda z - (apply res xx z)) + (res xx) res))))) (unx mrefx- mref-q) @@ -291,6 +290,13 @@ explicitly tell it to not update etc. (mset- x key val) (f key val)))) +(define-syntax-rule (mklam (mset a ...) val) + (if (procedure? val) + (if (procedure-property val 'py-special) + (mset a ... val) + (mset a ... (object-method val))) + (mset a ... val))) + (define-method (set (x <pf>) key val) (mset x key val)) (define-method (set (x <p>) key val) (mset- x key val)) (define-method (set (x <pyf>) key val) (mset-py x key val)) @@ -647,3 +653,27 @@ explicitly tell it to not update etc. (define-method (py-class (o <p>)) (ref o '__class__ 'type)) + +(define (mark-fkn f) + (set-procedure-property! f 'py-special #t) + f) + +(define (object-method f) + (mark-fkn + (lambda (x) + (if (pyclass? x) + f + (lambda z (apply f x z)))))) + +(define (class-method f) + (mark-fkn + (lambda (x) + (if (pyclass? x) + (lambda z (apply f x z)) + (lambda z (apply f (ref x '__class__) z)))))) + +(define (static-method f) + (mark-fkn + (lambda (x) f))) + + |