From 988c879292acffbbf86367601c41ad7c010ff160 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sat, 5 Nov 2016 12:51:44 +1300
Subject: [PATCH] Fixed bug in (display)

---
 scheme-primitives.4th | 20 ++++++++++++++++----
 scheme.4th            |  2 +-
 2 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/scheme-primitives.4th b/scheme-primitives.4th
index 97c098f..b71b98d 100644
--- a/scheme-primitives.4th
+++ b/scheme-primitives.4th
@@ -367,19 +367,31 @@ defer display
     2dup
     car display
     cdr
-    nil-type istype? if 2drop exit then
+    nil? if 2drop exit then
     pair-type istype? if space recurse exit then
     ."  . " display
 ;
 
 : displaychar ( charobj -- )
-    drop emit
+    drop emit ;
+
+: (displaystring) ( charlist -- )
+    nil? if
+        2drop
+    else
+        2dup car displaychar
+        cdr recurse
+    then
+;
+
+: displaystring ( stringobj -- )
+    drop pair-type (displaystring)
 ;
 
 :noname ( obj -- )
     pair-type istype? if ." (" displaypair ." )" exit then
     character-type istype? if displaychar exit then
-    string-type istype? if (printstring) exit then
+    string-type istype? if displaystring exit then
     
     print
 ; is display
@@ -388,7 +400,7 @@ defer display
     2dup 1 ensure-arg-count
     car string-type ensure-arg-type
 
-    (printstring)
+    displaystring
 
     none
 ; make-primitive display-string
diff --git a/scheme.4th b/scheme.4th
index 4ccf7d8..f2d7375 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -1456,7 +1456,7 @@ hide env
 ;
 
 : (printstring) ( stringobj -- )
-    nil-type istype? if 2drop exit then
+    nil? if 2drop exit then
 
     2dup car drop dup
     case
-- 
2.20.1