From 59038a10f0e3ad65675cafdb149eb61405e334d3 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Fri, 6 Feb 2015 00:38:34 -0500
Subject: forth: Added lists, ints, symbols for step 1

---
 forth/printer.fs | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 96 insertions(+)
 create mode 100644 forth/printer.fs

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
new file mode 100644
index 0000000..5ff28e5
--- /dev/null
+++ b/forth/printer.fs
@@ -0,0 +1,96 @@
+require types.fs
+
+: safe-type ( str-addr str-len -- )
+    dup 256 > if
+        drop 256 type ." ...<lots more>" type
+    else
+        type
+    endif ;
+
+\ === mutable string buffer === /
+\ string buffer that maintains an allocation larger than the current
+\ string size.  When appending would cause the string size exceed the
+\ current allocation, resize is used to double the allocation. The
+\ current allocation is not stored anywhere, but computed based on
+\ current string size or str-base-size, whichever is larger.
+64 constant str-base-size
+
+: new-str ( -- addr length )
+  str-base-size allocate throw 0 ;
+
+: round-up ( n -- n )
+  2
+  begin
+    1 lshift 2dup <
+  until
+  swap drop ;
+
+: str-append { buf-addr buf-str-len str-addr str-len }
+  buf-str-len str-len +
+  { new-len }
+  new-len str-base-size > if
+    buf-str-len new-len xor buf-str-len > if
+      buf-addr new-len round-up resize throw
+      to buf-addr
+    endif
+  endif
+  str-addr buf-addr buf-str-len + str-len cmove
+  buf-addr new-len ;
+
+\ define a-space, to append a space char to a string
+bl c,
+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
+
+: int>str ( num -- str-addr str-len )
+  s>d <# #s #> ;
+
+
+\ === printer protocol and implementations === /
+
+def-protocol-method pr-buf ( str-addr str-len this -- str-addr str-len )
+
+: pr-str { obj }
+    new-str obj pr-buf ;
+
+\ Examples of extending existing protocol methods to existing type
+MalDefault
+  extend pr-buf
+    { this }
+    s" #<MalObject" str-append a-space
+    this int>str str-append
+    s" >" str-append ;;
+drop
+
+MalNil
+  extend pr-buf
+    drop s" nil" str-append ;;
+drop
+
+MalList
+  extend pr-buf
+    -rot s" (" str-append ( list str-addr str-len )
+    rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
+    begin ( list str-addr str-len )
+      2 pick mal-nil <>
+    while
+      a-space
+      rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
+    repeat
+    s" )" str-append rot drop ;;
+drop
+
+MalInt
+  extend pr-buf
+    MalInt/int @ int>str str-append ;;
+drop
+
+MalSymbol
+  extend pr-buf
+    dup MalSymbol/sym-addr @
+    swap MalSymbol/sym-len @
+    str-append ;;
+drop
-- 
cgit v1.2.3


From 50e417ffe32c238189e61c9701696602d40bb7f3 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Fri, 6 Feb 2015 02:38:58 -0500
Subject: forth: Add string printing

---
 forth/printer.fs | 38 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

(limited to 'forth/printer.fs')

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
-- 
cgit v1.2.3


From 168fb5dc56fee6653816ee8236259940e575c7ec Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Fri, 6 Feb 2015 23:58:41 -0500
Subject: forth: Add step 1, but not maps

---
 forth/printer.fs | 35 ++++++++++++++++++++++++++++-------
 1 file changed, 28 insertions(+), 7 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 8882e13..243780a 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -70,9 +70,7 @@ MalNil
     drop s" nil" str-append ;;
 drop
 
-MalList
-  extend pr-buf
-    -rot s" (" str-append ( list str-addr str-len )
+: pr-buf-list ( list str-addr str-len -- str-addr str-len)
     rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
     begin ( list str-addr str-len )
       2 pick mal-nil <>
@@ -80,7 +78,22 @@ MalList
       a-space
       rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
     repeat
-    s" )" str-append rot drop ;;
+    rot drop ;
+
+
+MalList
+  extend pr-buf
+    -rot s" (" str-append ( list str-addr str-len )
+    pr-buf-list
+    s" )" str-append ;;
+drop
+
+MalVector
+  extend pr-buf
+    MalVector/list @
+    -rot s" [" str-append ( list str-addr str-len )
+    pr-buf-list
+    s" ]" str-append ;;
 drop
 
 MalInt
@@ -112,19 +125,27 @@ MalString
     s\" \"" str-append
     0 ( i )
     begin
+        dup len <
+    while
         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 10 = if ( i ) \ newline?
+                drop dup addr len rot insert-\ to len to addr
                 dup addr + 1+ [char] n swap c!
                 1+
+            else
+                13 = if ( i ) \ return?
+                    dup addr len rot insert-\ to len to addr
+                    dup addr + 1+ [char] r swap c!
+                    1+
+                endif
             endif
         endif
         1+
-    dup len = until
+    repeat
     drop addr len str-append
     s\" \"" str-append ;;
 drop
-- 
cgit v1.2.3


From 2e78e94eb894e511e583db03286a3c13b9ecc780 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sat, 7 Feb 2015 10:01:31 -0500
Subject: forth: Finished step 1

---
 forth/printer.fs | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 243780a..1244c08 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -70,17 +70,18 @@ MalNil
     drop s" nil" str-append ;;
 drop
 
+: pr-buf-list-item ( list str-addr str-len -- list str-addr str-len)
+    rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf ;
+
 : pr-buf-list ( list str-addr str-len -- str-addr str-len)
-    rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
+    pr-buf-list-item
     begin ( list str-addr str-len )
       2 pick mal-nil <>
     while
-      a-space
-      rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf
+      a-space pr-buf-list-item
     repeat
     rot drop ;
 
-
 MalList
   extend pr-buf
     -rot s" (" str-append ( list str-addr str-len )
@@ -96,6 +97,21 @@ MalVector
     s" ]" str-append ;;
 drop
 
+MalMap
+  extend pr-buf
+    MalMap/list @
+    -rot s" {" str-append ( list str-addr str-len )
+    pr-buf-list-item a-space pr-buf-list-item
+    begin ( list str-addr str-len )
+      2 pick mal-nil <>
+    while
+      s" , " str-append
+      pr-buf-list-item a-space pr-buf-list-item
+    repeat
+    rot drop
+    s" }" str-append ;;
+drop
+
 MalInt
   extend pr-buf
     MalInt/int @ int>str str-append ;;
-- 
cgit v1.2.3


From 9da223a35a176d94fbb75cbcc1000871ff5aff0b Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Thu, 12 Feb 2015 19:27:00 -0500
Subject: forth: Add step 2

---
 forth/printer.fs | 72 ++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 54 insertions(+), 18 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 1244c08..d85e38b 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -2,7 +2,7 @@ require types.fs
 
 : safe-type ( str-addr str-len -- )
     dup 256 > if
-        drop 256 type ." ...<lots more>" type
+        drop 256 type ." ...<lots more>"
     else
         type
     endif ;
@@ -52,6 +52,8 @@ 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 )
 
 : pr-str { obj }
     new-str obj pr-buf ;
@@ -73,27 +75,59 @@ drop
 : pr-buf-list-item ( list str-addr str-len -- list str-addr str-len)
     rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf ;
 
-: pr-buf-list ( list str-addr str-len -- str-addr str-len)
-    pr-buf-list-item
+MalList
+  extend pr-buf
+    -rot s" (" str-append ( list str-addr str-len )
+    rot pr-seq-buf
+    s" )" str-append ;;
+  extend pr-seq-buf
+    \ currently assumes list chain through to the end
+    -rot pr-buf-list-item
     begin ( list str-addr str-len )
       2 pick mal-nil <>
     while
       a-space pr-buf-list-item
     repeat
-    rot drop ;
+    rot drop ;;
+  extend pr-pairs-buf
+    -rot pr-buf-list-item a-space pr-buf-list-item
+    begin ( list str-addr str-len )
+      2 pick mal-nil <>
+    while
+      s" , " str-append
+      pr-buf-list-item a-space pr-buf-list-item
+    repeat
+    rot drop ;;
+drop
 
-MalList
+MalArray
   extend pr-buf
     -rot s" (" str-append ( list str-addr str-len )
-    pr-buf-list
+    rot pr-seq-buf
     s" )" str-append ;;
+  extend pr-seq-buf { ary }
+    ary MalArray/start @ { start }
+    start @ pr-buf
+    ary MalArray/count @ 1 ?do
+        a-space
+        start i cells + @ pr-buf
+    loop ;;
+  extend pr-pairs-buf { ary }
+    ary MalArray/start @ { start }
+    start @ pr-buf a-space start cell+ @ pr-buf
+    ary MalArray/count @ 2 / 1 ?do
+        s" , " str-append
+        a-space
+        start i 2 * cells + @ pr-buf a-space
+        start i 2 * 1+ cells + @ pr-buf
+    loop ;;
 drop
 
 MalVector
   extend pr-buf
     MalVector/list @
     -rot s" [" str-append ( list str-addr str-len )
-    pr-buf-list
+    rot pr-seq-buf
     s" ]" str-append ;;
 drop
 
@@ -101,14 +135,7 @@ MalMap
   extend pr-buf
     MalMap/list @
     -rot s" {" str-append ( list str-addr str-len )
-    pr-buf-list-item a-space pr-buf-list-item
-    begin ( list str-addr str-len )
-      2 pick mal-nil <>
-    while
-      s" , " str-append
-      pr-buf-list-item a-space pr-buf-list-item
-    repeat
-    rot drop
+    rot pr-pairs-buf
     s" }" str-append ;;
 drop
 
@@ -117,11 +144,20 @@ MalInt
     MalInt/int @ int>str str-append ;;
 drop
 
+MalFn
+  extend pr-buf
+    drop s" #<fn>" str-append ;;
+drop
+
 MalSymbol
   extend pr-buf
-    dup MalSymbol/sym-addr @
-    swap MalSymbol/sym-len @
-    str-append ;;
+    unpack-sym str-append ;;
+drop
+
+MalKeyword
+  extend pr-buf { kw }
+    s" :" str-append
+    kw unpack-keyword str-append ;;
 drop
 
 : insert-\ ( str-addr str-len insert-idx -- str-addr str-len )
-- 
cgit v1.2.3


From 69972a8399efe4abb8567526e90262e131f90d26 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sat, 14 Feb 2015 13:40:07 -0500
Subject: forth: Add step 3

---
 forth/printer.fs | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index d85e38b..cc376e6 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -149,6 +149,11 @@ MalFn
     drop s" #<fn>" str-append ;;
 drop
 
+SpecialOp
+  extend pr-buf
+    drop s" #<op>" str-append ;;
+drop
+
 MalSymbol
   extend pr-buf
     unpack-sym str-append ;;
-- 
cgit v1.2.3


From c05d35e8dd1ebbc371d7c9239d788ddf844eae31 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sat, 14 Feb 2015 15:18:18 -0500
Subject: forth: Get rid of car/cdr style lists

Rename MalArray to MalList
---
 forth/printer.fs | 40 ++++++----------------------------------
 1 file changed, 6 insertions(+), 34 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index cc376e6..78ac197 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -72,50 +72,22 @@ MalNil
     drop s" nil" str-append ;;
 drop
 
-: pr-buf-list-item ( list str-addr str-len -- list str-addr str-len)
-    rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf ;
-
 MalList
   extend pr-buf
     -rot s" (" str-append ( list str-addr str-len )
     rot pr-seq-buf
     s" )" str-append ;;
-  extend pr-seq-buf
-    \ currently assumes list chain through to the end
-    -rot pr-buf-list-item
-    begin ( list str-addr str-len )
-      2 pick mal-nil <>
-    while
-      a-space pr-buf-list-item
-    repeat
-    rot drop ;;
-  extend pr-pairs-buf
-    -rot pr-buf-list-item a-space pr-buf-list-item
-    begin ( list str-addr str-len )
-      2 pick mal-nil <>
-    while
-      s" , " str-append
-      pr-buf-list-item a-space pr-buf-list-item
-    repeat
-    rot drop ;;
-drop
-
-MalArray
-  extend pr-buf
-    -rot s" (" str-append ( list str-addr str-len )
-    rot pr-seq-buf
-    s" )" str-append ;;
-  extend pr-seq-buf { ary }
-    ary MalArray/start @ { start }
+  extend pr-seq-buf { list }
+    list MalList/start @ { start }
     start @ pr-buf
-    ary MalArray/count @ 1 ?do
+    list MalList/count @ 1 ?do
         a-space
         start i cells + @ pr-buf
     loop ;;
-  extend pr-pairs-buf { ary }
-    ary MalArray/start @ { start }
+  extend pr-pairs-buf { list }
+    list MalList/start @ { start }
     start @ pr-buf a-space start cell+ @ pr-buf
-    ary MalArray/count @ 2 / 1 ?do
+    list MalList/count @ 2 / 1 ?do
         s" , " str-append
         a-space
         start i 2 * cells + @ pr-buf a-space
-- 
cgit v1.2.3


From 60801ed68d5b2c6630c83883de150ccce98767f9 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sun, 15 Feb 2015 13:33:44 -0500
Subject: forth: Add step 4, but not varargs

---
 forth/printer.fs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 78ac197..39ddb8e 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -67,10 +67,9 @@ MalDefault
     s" >" str-append ;;
 drop
 
-MalNil
-  extend pr-buf
-    drop s" nil" str-append ;;
-drop
+MalNil   extend pr-buf drop s" nil"   str-append ;; drop
+MalTrue  extend pr-buf drop s" true"  str-append ;; drop
+MalFalse extend pr-buf drop s" false" str-append ;; drop
 
 MalList
   extend pr-buf
@@ -78,12 +77,14 @@ MalList
     rot pr-seq-buf
     s" )" str-append ;;
   extend pr-seq-buf { list }
-    list MalList/start @ { start }
-    start @ pr-buf
-    list MalList/count @ 1 ?do
-        a-space
-        start i cells + @ pr-buf
-    loop ;;
+    list MalList/count @ 0 > if
+        list MalList/start @ { start }
+        start @ pr-buf
+        list MalList/count @ 1 ?do
+            a-space
+            start i cells + @ pr-buf
+        loop
+    endif ;;
   extend pr-pairs-buf { list }
     list MalList/start @ { start }
     start @ pr-buf a-space start cell+ @ pr-buf
-- 
cgit v1.2.3


From 136ce7c9afb5e103133fe6e423e6dad3d23db38d Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sun, 15 Feb 2015 14:10:47 -0500
Subject: forth: Split types for user fns vs native fns

---
 forth/printer.fs | 14 +++-----------
 1 file changed, 3 insertions(+), 11 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 39ddb8e..0474944 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -62,7 +62,9 @@ def-protocol-method pr-pairs-buf ( str-addr str-len this -- str-addr str-len )
 MalDefault
   extend pr-buf
     { this }
-    s" #<MalObject" str-append a-space
+    s" #<" str-append
+    this mal-type @ type-name str-append
+    a-space
     this int>str str-append
     s" >" str-append ;;
 drop
@@ -117,16 +119,6 @@ MalInt
     MalInt/int @ int>str str-append ;;
 drop
 
-MalFn
-  extend pr-buf
-    drop s" #<fn>" str-append ;;
-drop
-
-SpecialOp
-  extend pr-buf
-    drop s" #<op>" str-append ;;
-drop
-
 MalSymbol
   extend pr-buf
     unpack-sym str-append ;;
-- 
cgit v1.2.3


From 785786c6033c97a70e78fb6b684d58aea18df4ae Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sun, 15 Feb 2015 17:44:52 -0500
Subject: forth: Finish step 4

---
 forth/printer.fs | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

(limited to 'forth/printer.fs')

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
-- 
cgit v1.2.3


From cd21ff0d3ccfbec62fe6af95e6656fe9c38f8254 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Mon, 16 Feb 2015 02:01:56 -0500
Subject: forth: Fix critical string-resizing bug

---
 forth/printer.fs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 6152993..d035e94 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -28,7 +28,7 @@ require types.fs
 : str-append { buf-addr buf-str-len str-addr str-len }
   buf-str-len str-len +
   { new-len }
-  new-len str-base-size > if
+  new-len str-base-size >= if
     buf-str-len new-len xor buf-str-len > if
       buf-addr new-len round-up resize throw
       to buf-addr
-- 
cgit v1.2.3


From bf6a574e00a221dfe564ba11148deaa73ba8a229 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Mon, 16 Feb 2015 20:12:44 -0500
Subject: forth: Add step 6, clean up comment parsing

---
 forth/printer.fs | 41 +++++++++--------------------------------
 1 file changed, 9 insertions(+), 32 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index d035e94..5309745 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -130,40 +130,17 @@ MalKeyword
     kw unpack-keyword 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
-    ;
-
 : escape-str { addr len }
     s\" \"" str-append
-    0 ( i )
-    begin
-        dup len <
-    while
-        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
-            dup 10 = if ( i ) \ newline?
-                drop dup addr len rot insert-\ to len to addr
-                dup addr + 1+ [char] n swap c!
-                1+
-            else
-                13 = if ( i ) \ return?
-                    dup addr len rot insert-\ to len to addr
-                    dup addr + 1+ [char] r swap c!
-                    1+
-                endif
-            endif
-        endif
-        1+
-    repeat
-    drop addr len str-append
+    addr len +  addr  ?do
+        i c@ case
+            [char] " of s\" \\\"" str-append endof
+            [char] \ of s\" \\\\" str-append endof
+            10 of s\" \\n" str-append endof
+            13 of s\" \\r" str-append endof
+            -rot i 1 str-append rot
+        endcase
+    loop
     s\" \"" str-append ;
 
 MalString
-- 
cgit v1.2.3


From 580c4eef9d61f39264813b662fe5335c3c3c4ee5 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Tue, 17 Feb 2015 18:47:23 -0500
Subject: forth: Add step 9, just try*/throw

- Moved some stuff out of printer into str,
  to support throwing strings in types.fs
- Fixed an apparently completely broken 'nth'
- Still failing 120 step9 tests
---
 forth/printer.fs | 50 +-------------------------------------------------
 1 file changed, 1 insertion(+), 49 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 5309745..645e5da 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -1,54 +1,6 @@
+require str.fs
 require types.fs
 
-: safe-type ( str-addr str-len -- )
-    dup 256 > if
-        drop 256 type ." ...<lots more>"
-    else
-        type
-    endif ;
-
-\ === mutable string buffer === /
-\ string buffer that maintains an allocation larger than the current
-\ string size.  When appending would cause the string size exceed the
-\ current allocation, resize is used to double the allocation. The
-\ current allocation is not stored anywhere, but computed based on
-\ current string size or str-base-size, whichever is larger.
-64 constant str-base-size
-
-: new-str ( -- addr length )
-  str-base-size allocate throw 0 ;
-
-: round-up ( n -- n )
-  2
-  begin
-    1 lshift 2dup <
-  until
-  nip ;
-
-: str-append { buf-addr buf-str-len str-addr str-len }
-  buf-str-len str-len +
-  { new-len }
-  new-len str-base-size >= if
-    buf-str-len new-len xor buf-str-len > if
-      buf-addr new-len round-up resize throw
-      to buf-addr
-    endif
-  endif
-  str-addr buf-addr buf-str-len + str-len cmove
-  buf-addr new-len ;
-
-\ define a-space, to append a space char to a string
-bl c,
-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 ;
-
-: int>str ( num -- str-addr str-len )
-  s>d <# #s #> ;
-
-
 \ === printer protocol and implementations === /
 
 def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len )
-- 
cgit v1.2.3


From 224e09ed42325f000ee9a31a500bebe03a1ba97c Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Wed, 18 Feb 2015 19:57:39 -0500
Subject: forth: Finish step 9

---
 forth/printer.fs | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

(limited to 'forth/printer.fs')

diff --git a/forth/printer.fs b/forth/printer.fs
index 645e5da..85f88a0 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -5,7 +5,6 @@ require types.fs
 
 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 }
     true new-str obj pr-buf rot drop ;
@@ -39,15 +38,6 @@ MalList
             start i cells + @ pr-buf
         loop
     endif ;;
-  extend pr-pairs-buf { list }
-    list MalList/start @ { start }
-    start @ pr-buf a-space start cell+ @ pr-buf
-    list MalList/count @ 2 / 1 ?do
-        s" , " str-append
-        a-space
-        start i 2 * cells + @ pr-buf a-space
-        start i 2 * 1+ cells + @ pr-buf
-    loop ;;
 drop
 
 MalVector
@@ -62,7 +52,17 @@ MalMap
   extend pr-buf
     MalMap/list @
     -rot s" {" str-append ( list str-addr str-len )
-    rot pr-pairs-buf
+    rot { list }
+    list MalList/count @ { count }
+    count 0 > if
+        list MalList/start @ { start }
+        start @ pr-buf a-space start cell+ @ pr-buf
+        count 2 / 1 ?do
+            s" , " str-append
+            start i 2 * cells + @ pr-buf a-space
+            start i 2 * 1+ cells + @ pr-buf
+        loop
+    endif
     s" }" str-append ;;
 drop
 
@@ -105,3 +105,10 @@ MalString
         str-append
     endif ;;
 drop
+
+Atom
+  extend pr-buf { this }
+    s" (atom " str-append
+    this Atom/val @ pr-buf
+    s" )" str-append ;;
+drop
\ No newline at end of file
-- 
cgit v1.2.3