diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-15 21:29:50 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-15 21:29:50 +0200 |
commit | 3d8e9a93996ea408a8a57a6074d82f6bc90b4cb1 (patch) | |
tree | c5f1180bdeda4a12f10ec43ca0372dcd21cb73a9 /modules/oop | |
parent | d307a4f6cf45c71f03480a2e2d8551d3b8c24523 (diff) |
Small improvements to the writer
Diffstat (limited to 'modules/oop')
-rw-r--r-- | modules/oop/pf-objects.scm | 84 |
1 files changed, 34 insertions, 50 deletions
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 |