From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 16 Mar 2019 05:27:01 +0000 (-0700)
Subject: Fix bug in printing of string slices.
X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~34
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8def1899b194e66211cdcd05f020385571e56152;p=mit-scheme.git

Fix bug in printing of string slices.
---

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 16c95026a..4e53cb8c0 100644
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -321,20 +321,22 @@ USA.
     def?))
 
 (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 8820d7981..c216d3ffd 100644
--- 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")