From 8de6f83b10097be8cdc30a67c9ebc6c4cef9cc3b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 5 Jan 2018 15:19:42 -0500 Subject: [PATCH] Reimplement bundle printers to be more like other printers. --- src/runtime/bundle.scm | 19 ++++++++++++------- src/runtime/runtime.pkg | 1 + 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm index 6f4ebf33e..c1fd3229d 100644 --- a/src/runtime/bundle.scm +++ b/src/runtime/bundle.scm @@ -131,15 +131,18 @@ USA. (tag bundle-metadata-tag) (alist bundle-metadata-alist)) +(define (define-bundle-printer interface printer) + (hash-table-set! bundle-printers (predicate->tag interface) printer)) + (set-record-type-entity-unparser-method! - (bracketed-unparser-method + (standard-unparser-method + (lambda (bundle) + (bim-name (tag-extra (bundle-tag bundle)))) (lambda (bundle port) - (write (bim-name (tag-extra (bundle-tag bundle))) port) - (write-string " " port) - (write (object-hash bundle) port) - (let ((handler (bundle-ref bundle 'write-self #f))) - (if handler - (handler port)))))) + (let ((printer + (hash-table-ref/default bundle-printers (bundle-tag bundle) #f))) + (if printer + (printer bundle port)))))) (define (bundle? object) (and (entity? object) @@ -170,9 +173,11 @@ USA. default)))) (define the-bundle-tag) +(define bundle-printers) (add-boot-init! (lambda () (register-predicate! bundle? 'bundle '<= entity?) (set! the-bundle-tag (predicate->tag bundle?)) + (set! bundle-printers (make-key-weak-eqv-hash-table)) (register-predicate! bundle-interface? 'bundle-interface '<= predicate?) (register-predicate! clauses? 'interface-clauses))) \ No newline at end of file diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index b24fde256..e2e36ff39 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1950,6 +1950,7 @@ USA. bundle-names bundle-ref bundle? + define-bundle-printer make-bundle make-bundle-interface)) -- 2.25.1