forth: Add string printing

3 files changed, 50 insertions, 4 deletions

diff --git a/forth/printer.fs b/forth/printer.fs
index 5ff28e5..8882e13 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -23,7 +23,7 @@ require types.fs
   begin
     1 lshift 2dup <
   until
-  swap drop ;
+  nip ;
 
 : str-append { buf-addr buf-str-len str-addr str-len }
   buf-str-len str-len +
@@ -43,7 +43,7 @@ here constant space-str
 : a-space space-str 1 str-append ;
 
 : str-append-char ( buf-addr buf-str-len char -- buf-addr buf-str-len )
-    pad ! pad 1 str-append ; \ refactoring str-append could perhaps make this faster
+    pad ! pad 1 str-append ;
 
 : int>str ( num -- str-addr str-len )
   s>d <# #s #> ;
@@ -94,3 +94,37 @@ MalSymbol
     swap MalSymbol/sym-len @
     str-append ;;
 drop
+
+: insert-\ ( str-addr str-len insert-idx -- str-addr str-len )
+    -rot 0 str-append-char { addr len }
+    dup   dup addr +   dup 1+  ( i i from to )
+    rot len swap - cmove> ( i ) \ shift " etc to the right
+    addr + [char] \ swap c! \ escape it!
+    addr len
+    ;
+
+MalString
+  extend pr-buf
+    dup MalString/str-addr @
+    swap MalString/str-len @
+    { addr len }
+
+    s\" \"" str-append
+    0 ( i )
+    begin
+        dup addr + c@ ( i char )
+        dup [char] " = over [char] \ = or if ( i char )
+            drop dup addr len rot insert-\ to len to addr
+            1+
+        else
+            10 = if ( i ) \ newline?
+                dup addr len rot insert-\ to len to addr
+                dup addr + 1+ [char] n swap c!
+                1+
+            endif
+        endif
+        1+
+    dup len = until
+    drop addr len str-append
+    s\" \"" str-append ;;
+drop
diff --git a/forth/step1_read_print.fs b/forth/step1_read_print.fs
index 9fe1470..33885d4 100644
--- a/forth/step1_read_print.fs
+++ b/forth/step1_read_print.fs
@@ -26,6 +26,7 @@ create buff 128 allot
 \ cr
 \ pr-str safe-type cr
 \ new-str s" hello" str-append char ! str-append-char safe-type
+\ s\" he\nllo" MalString. pr-str safe-type cr
 
 read-lines
 cr
diff --git a/forth/types.fs b/forth/types.fs
index 2b74576..75996f8 100644
--- a/forth/types.fs
+++ b/forth/types.fs
@@ -22,7 +22,7 @@
       endif
     else
       key > if         ( start end middle )
-        swap drop      ( start middle )
+        nip            ( start middle )
       else
         -rot 2drop dup ( middle middle )
       endif
@@ -187,7 +187,7 @@ def-protocol-method conj ( obj this -- this )
 \ Examples of extending existing protocol methods to existing type
 MalDefault
   extend conj   ( obj this -- this )
-    swap drop ;;
+    nip ;;
 drop
 
 MalNil
@@ -217,3 +217,14 @@ deftype* constant MalSymbol
     str-addr sym MalSymbol/sym-addr !
     str-len  sym MalSymbol/sym-len  !
     sym ;
+
+MalType%
+  cell% field MalString/str-addr
+  cell% field MalString/str-len
+deftype* constant MalString
+
+: MalString. { str-addr str-len -- mal-str }
+    MalString new { str }
+    str-addr str MalString/str-addr !
+    str-len  str MalString/str-len  !
+    str ;