Small improvements to the writer
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 15 Sep 2017 19:29:50 +0000 (21:29 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 15 Sep 2017 19:29:50 +0000 (21:29 +0200)
modules/language/python/exceptions.scm
modules/oop/pf-objects.scm

index 57690aa18dd3f364e367ca6b237837fcd5b753d6..52ce80781548777a0e77c168272c9c44c8bc1167 100644 (file)
@@ -22,9 +22,9 @@
     (lambda (self . l)
       (define port (if (pair? l) (car l) #f))
       (aif it (ref self 'str)
-           (format port "~s: ~a"
+           (format port "<~s: ~a>"
                    (ref self '__name__) it)
-           (format port "~s"
+           (format port "<~s>"
                    (ref self '__name__))))))
 
 
index c270e1127021a971ddc716b5d160b15905dcea24..c036144c3c2fe7abb7fdbca60e772c3edea01cb4 100644 (file)
@@ -614,56 +614,40 @@ explicitly tell it to not update etc.
     (set-procedure-property! name 'pyclass c)
     name))
 
-(define-method (write (o <p>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<p>: ~s" (class-name o)) l)))
-
-(define-method (display (o <p>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<p>: ~s" (class-name o)) l)))
-
-(define-method (write (o <p>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<p>: ~s" (class-name o)) l)))
-
-(define-method (display (o <p>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<pf>: ~s" (class-name o)) l)))
-
-(define-method (write (o <pf>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<pf>: ~s" (class-name o)) l)))
-
-(define-method (display (o <pf>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<p>: ~s" (class-name o)) l)))
-
-(define-method (write (o <py>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<py>: ~s" (class-name o)) l)))
-
-(define-method (display (o <py>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<py>: ~s" (class-name o)) l)))
-
-
-(define-method (write (o <pyf>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<pyf>: ~s" (class-name o)) l)))
-
-(define-method (display (o <pyf>) . l)
-  (aif it (ref o '__repr__)
-       (apply it l)
-       (apply display (format #f "object<pyf>: ~s" (class-name o)) l)))
+(define (get-class o)
+  (cond
+   ((procedure? o)
+    (aif it (procedure-property o 'pyclass)
+         it
+         (error "not an object ~a" o)))
+   (else
+    (class-of o))))
+
+(define (get-type o)
+  (cond
+   ((is-a? o <pyf>)
+    'pyf)
+   ((is-a? o <py>)
+    'py)
+   ((is-a? o <pf>)
+    'pf)
+   ((is-a? o <p>)
+    'p)
+   (else
+    'none)))
+
+(define (print o l)
+  (define port (if (pair? l) (car l) #t))
+  (format port
+          (aif it (ref o '__repr__)
+               (it)
+               (format #f
+                       "~a:~a" (get-type o) (ref o '__name__ 'None)))))
+
+(define-method (write (o <p>) . l) (print o l))
+(define-method (display (o <p>) . l) (print o l))
+
+
 
 (define-syntax-rule (define-python-class name parents code ...)
   (define name