try works

1 files changed, 44 insertions, 3 deletions

diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 761d44c..ca9968a 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -10,7 +10,8 @@
                 def-p-class   mk-p-class   make-p-class
                 def-pyf-class mk-pyf-class make-pyf-class
                 def-py-class  mk-py-class  make-py-class
-                StopIteration))
+                StopIteration
+                Exception))
 
 #|
 Python object system is basically syntactic suger otop of a hashmap and one
@@ -598,5 +599,45 @@ explicitly tell it to not update etc.
     (lambda (x) #:nil)))
        
 
-
-
+(define-inlinable (super-obj tag ex)
+  (let* ((classtag (ref tag '__class__ #f))
+         (exid     (ref ex '__goops__ #f)))
+    (let check-class ((tag classtag))
+      (if (eq? (ref tag '__goops__ #f) exid)
+          #t
+          (let lp ((parents (ref tag '__parents__ '())))
+            (if (pair? parents)
+                (or
+                 (check-class (car parents))
+                 (lp (cdr parents)))
+                #f))))))
+
+(define-inlinable (pyclass? x)
+  (and (procedure? x) (procedure-property x 'pyclass)))
+
+
+(define-method (testex py (tag <p>) (ex <p>) . l)
+  (super-obj tag ex))
+
+(define-method (testex py tag ex l)
+  (if (eq? py 'python)
+      (cond
+       ((pair? ex)
+        (or
+         (testex py tag (car ex) l)
+         (testex py tag (cdr ex) l)))
+       ((pyclass? ex)
+        =>
+        (lambda (cl)
+          (testex py tag cl l))))))
+
+
+
+(define Exception
+  (wrap
+   (mk-py-class Exception ()
+                #:const
+                ((define __init__
+                   (lambda (self) (values))))                
+                #:dynamic
+                ())))