forth: Finish step 4

3 files changed, 40 insertions, 26 deletions

diff --git a/forth/core.fs b/forth/core.fs
index 6dd4ec4..4982a0e 100644
--- a/forth/core.fs
+++ b/forth/core.fs
@@ -48,8 +48,8 @@ defcore not
         endif
     endif ;;
 
-: pr-str-multi ( argv argc )
-    ?dup 0= if drop s" "
+: pr-str-multi ( readably? argv argc )
+    ?dup 0= if drop 0 0
     else
         { argv argc }
         new-str
@@ -60,8 +60,17 @@ defcore not
         loop
     endif ;
 
-defcore prn pr-str-multi type cr mal-nil ;;
-defcore pr-str pr-str-multi MalString. ;;
-
-defcore str drop @ pr-str MalString. ;;
-defcore println pr-str-multi 10 str-append-char MalString. ;;
+defcore prn true -rot pr-str-multi type cr drop mal-nil ;;
+defcore pr-str true -rot pr-str-multi MalString. nip ;;
+defcore println false -rot pr-str-multi type cr drop mal-nil ;;
+defcore str ( argv argc )
+    dup 0= if
+        MalString.
+    else
+        { argv argc }
+        false new-str
+        argc 0 ?do
+            argv i cells + @ pr-buf
+        loop
+        MalString. nip
+    endif ;;
diff --git a/forth/printer.fs b/forth/printer.fs
index 0474944..6152993 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -51,12 +51,12 @@ here constant space-str
 
 \ === printer protocol and implementations === /
 
-def-protocol-method pr-buf ( str-addr str-len this -- str-addr str-len )
-def-protocol-method pr-seq-buf ( str-addr str-len this -- str-addr str-len )
-def-protocol-method pr-pairs-buf ( str-addr str-len this -- str-addr str-len )
+def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len )
+def-protocol-method pr-seq-buf ( readably? str-addr str-len this -- str-addr str-len )
+def-protocol-method pr-pairs-buf ( readably? str-addr str-len this -- str-addr str-len )
 
 : pr-str { obj }
-    new-str obj pr-buf ;
+    true new-str obj pr-buf rot drop ;
 
 \ Examples of extending existing protocol methods to existing type
 MalDefault
@@ -138,12 +138,7 @@ drop
     addr len
     ;
 
-MalString
-  extend pr-buf
-    dup MalString/str-addr @
-    swap MalString/str-len @
-    { addr len }
-
+: escape-str { addr len }
     s\" \"" str-append
     0 ( i )
     begin
@@ -169,5 +164,15 @@ MalString
         1+
     repeat
     drop addr len str-append
-    s\" \"" str-append ;;
+    s\" \"" str-append ;
+
+MalString
+  extend pr-buf
+    dup MalString/str-addr @
+    swap MalString/str-len @
+    4 pick if
+        escape-str
+    else
+        str-append
+    endif ;;
 drop
diff --git a/forth/types.fs b/forth/types.fs
index 51f04ed..1a132be 100644
--- a/forth/types.fs
+++ b/forth/types.fs
@@ -118,7 +118,7 @@ MalType% deftype MalFalse MalFalse new constant mal-false
 
 : not-object? ( obj -- bool )
     dup 7 and 0 <> if
-        drop -1
+        drop true
     else
         1000000 <
     endif ;
@@ -232,7 +232,7 @@ def-protocol-method mal-count ( obj -- mal-int )
 
 : m= ( a b -- bool )
     2dup = if
-        2drop -1
+        2drop true
     else
         mal=
     endif ;
@@ -293,16 +293,16 @@ MalList
     else
         2dup MalList/count @ swap MalList/count @ over = if ( list-a list-b count )
             -rot MalList/start @ swap MalList/start @ { start-b start-a }
-            -1 swap ( return-val count )
+            true swap ( return-val count )
             0 ?do
                 start-a i cells + @
                 start-b i cells + @
                 m= if else
-                    drop 0 leave
+                    drop false leave
                 endif
             loop
         else
-            drop 2drop 0
+            drop 2drop false
         endif
     endif ;;
 drop
@@ -351,12 +351,12 @@ MalMap
     0
     begin
         dup count >= if
-            drop not-found -1
+            drop not-found true
         else
             start over cells + @ k m= if
-                start swap cells + cell+ @ -1 \ found it ( value -1 )
+                start swap cells + cell+ @ true \ found it ( value true )
             else
-                2 + 0
+                2 + false
             endif
         endif
     until ;;