From 98f11c126a243596efe83fffa6af09b262ecaeac Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Tue, 3 Oct 2017 21:44:56 +0200
Subject: decorators works

---
 modules/oop/pf-objects.scm | 38 ++++++++++++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 4 deletions(-)

(limited to 'modules/oop/pf-objects.scm')

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)))
+
+        
-- 
cgit v1.2.3