From 8def1899b194e66211cdcd05f020385571e56152 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 | 33 +++++++++++++++++----------------
 src/runtime/runtime.pkg |  4 +++-
 2 files changed, 20 insertions(+), 17 deletions(-)

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")
-- 
2.25.1