From 3d8e9a93996ea408a8a57a6074d82f6bc90b4cb1 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Fri, 15 Sep 2017 21:29:50 +0200
Subject: [PATCH] Small improvements to the writer

---
 modules/language/python/exceptions.scm |  4 +-
 modules/oop/pf-objects.scm             | 84 +++++++++++---------------
 2 files changed, 36 insertions(+), 52 deletions(-)

diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 57690aa..52ce807 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -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__))))))
 
 
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index c270e11..c036144 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -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
-- 
2.31.1