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