From c4e2cb4cff938ad9d2ae554611068805521d79f6 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 15 Mar 2019 22:27:01 -0700
Subject: [PATCH] Fix bug in printing of string slices.

---
 src/runtime/printer.scm | 42 +++++++++++++++++++++--------------------
 src/runtime/runtime.pkg |  4 +++-
 2 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 125ffaef6..d81b83c7e 100644
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -301,24 +301,27 @@ 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
-	    (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 c6c058815..6995779d6 100644
--- 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")
-- 
2.25.1