From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sun, 10 Jul 2016 04:06:46 +0000 (+1200)
Subject: Fixing up pair read/print
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=47b94d7af3449341b96f8e1b420c708c9a4c2fc2;p=scheme.forth.jl.git

Fixing up pair read/print
---

diff --git a/scheme.4th b/scheme.4th
index 7fcbb30..75055ff 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -259,7 +259,6 @@ parse-idx-stack parse-idx-sp !
 defer read
 
 : readpair ( -- obj )
-    inc-parse-idx
     eatspaces
 
     \ Empty lists
@@ -272,7 +271,9 @@ defer read
             reset-term abort
         then
 
-        nil-type exit
+        dec-parse-idx
+
+        0 nil-type exit
     then
 
     \ Read first pair element
@@ -320,7 +321,21 @@ defer read
     then
 
     pair? if
+        inc-parse-idx
+
+        eatspaces
+
         readpair
+
+        eatspaces
+
+        nextchar [char] ) <> if
+            bold red ." Missing closing paren." reset-term cr
+            abort
+        then
+
+        inc-parse-idx
+
         exit
     then
 
@@ -383,13 +398,12 @@ defer read
 
 defer print
 : printpair ( pairobj -- )
-    ." ("
     2dup
     car print
     cdr
     nil-type istype? if 2drop ." )" exit then
-    pair-type istype? if recurse ." )" exit then
-    ."  . " print ." )"
+    pair-type istype? if space recurse exit then
+    ."  . " print
 ;
 
 :noname ( obj -- )
@@ -397,7 +411,7 @@ defer print
     boolean-type istype? if printbool exit then
     character-type istype? if printchar exit then
     nil-type istype? if printnil exit then
-    pair-type istype? if printpair exit then
+    pair-type istype? if ." (" printpair ." )" exit then
 
     bold fg red ." Error printing expression - unrecognized type. Aborting" reset-term cr
     abort