Reimplement bundle printers to be more like other printers.

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index 6f4ebf33e8eb1091d6c993771378ae694242490c..c1fd3229d038b53da27ab5426ee7b58e5fccfe14 100644 (file)
--- 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! <bundle-metadata>
-  (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 b24fde2563f3935e79ae5554035b065c57655c22..e2e36ff395b25416e5808cd7cbe6ae68fca3c9d2 100644 (file)
--- 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))