Fix bug in printing of string slices.

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 125ffaef669048e7bb7bd610e3639d73dcb022a2..d81b83c7ef5296770c617b4639c6fe38d3f3fa61 100644 (file)
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -301,24 +301,27 @@ USA.
     def?))
 \f
 (define (print-object-1 object context)
-  (let ((print-method (get-print-method object)))
-    (cond ((standard-print-method? print-method)
-          (*print-with-brackets
-           (standard-print-method-name print-method object)
-           object
-           context
-           (lambda (context*)
-             (for-each (lambda (part)
-                         (*print-char #\space context*)
-                         (print-object part context*))
-                       (standard-print-method-parts print-method object)))))
-         (print-method
-          (call-print-method print-method object context))
-         (else
-          ((vector-ref dispatch-table
-                       ((ucode-primitive primitive-object-type 1) object))
-           object
-           context)))))
+  (cond ((string-slice? object)
+        (print-string object context))
+       ((get-print-method object)
+        => (lambda (print-method)
+             (if (standard-print-method? print-method)
+                 (*print-with-brackets
+                  (standard-print-method-name print-method object)
+                  object
+                  context
+                  (lambda (context*)
+                    (for-each (lambda (part)
+                                (*print-char #\space context*)
+                                (print-object part context*))
+                              (standard-print-method-parts print-method
+                                                           object))))
+                 (call-print-method print-method object context))))
+       (else
+        ((vector-ref dispatch-table
+                     ((ucode-primitive primitive-object-type 1) object))
+         object
+         context))))
 
 (define (call-print-method print-method object context)
   (parameterize ((initial-context context))
@@ -697,8 +700,7 @@ USA.
            (*print-string "#u8()" context*))))))
 
 (define (print-record record context)
-  (cond ((string? record) (print-string record context))
-       ((uri? record) (print-uri record context))
+  (cond ((uri? record) (print-uri record context))
        ((get-param:print-with-maximum-readability?)
         (*print-readable-hash record context))
        (else

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index c6c058815b8365e1e8fe840cbeccdb8495917c85..6995779d6d4c9414e37005013acd14c02a7bf08c 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1146,7 +1146,9 @@ USA.
          %ustring1?
          cp1-ref
          cp1-set!
-         ustring-length))
+         ustring-length)
+  (export (runtime printer)
+         (string-slice? slice?)))
 
 (define-package (runtime bytevector)
   (files "bytevector")