Fix bug in printing of string slices.

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 16c95026a5a3b5a1cf7ff6e8d42196d7f0524412..4e53cb8c0d89e5aa8afed6d1db4e63dddecebb3b 100644 (file)
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -321,20 +321,22 @@ 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
-           (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
+                  (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))
@@ -757,8 +759,7 @@ USA.
       (*print-char #\) 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))
        (else (*print-with-brackets 'record record context '()))))
 
 (define (print-uri uri context)

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