forth: Added lists, ints, symbols for step 1

1 files changed, 92 insertions, 0 deletions

diff --git a/forth/reader.fs b/forth/reader.fs
new file mode 100644
index 0000000..6ed9fb5
--- /dev/null
+++ b/forth/reader.fs
@@ -0,0 +1,92 @@
+require types.fs
+require printer.fs
+
+\ Drop a char off the front of string by advancing the addr and
+\ decrementing the length, and fetch next char
+: adv-str ( str-addr str-len -- str-addr str-len char )
+    swap 1+ swap 1-
+    dup 0= if 0 ( eof )
+    else over c@ endif ;
+
+: skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char )
+    begin
+        dup bl =
+    while ( str-addr str-len space-char )
+        drop adv-str
+    repeat ;
+
+: mal-digit? ( char -- flag )
+    dup [char] 9 <= if
+        [char] 0 >=
+    else
+        drop 0
+    endif ;
+
+: char-in-str? ( char str-addr str-len )
+    rot { needle }
+    begin ( str-addr str-len )
+        adv-str needle = if
+            2drop -1 -1 \ success! drop and exit
+        else
+            dup 0= if
+                2drop 0 -1 \ str consumed, char not found.
+            else
+                0 \ continue
+            endif
+        endif
+    until ;
+
+s\" []{}()'\"`,; " constant non-sym-chars-len constant non-sym-chars
+: sym-char? ( char -- flag )
+    non-sym-chars non-sym-chars-len char-in-str? 0= ;
+
+defer read-form ( str-addr str-len -- str-addr str-len mal-obj )
+
+: read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int )
+    0 { int }
+    begin ( str-addr str-len digit-char )
+        [char] 0 - int 10 * + to int ( str-addr str-len )
+        adv-str dup mal-digit? 0= ( str-addr str-len digit-char )
+    until
+    int MalInt. ;
+
+: read-symbol-str ( str-addr str-len sym-char -- str-addr str-len sym-addr sym-len )
+    new-str { sym-addr sym-len }
+    begin ( str-addr srt-len sym-char )
+        sym-addr sym-len rot str-append-char to sym-len to sym-addr
+        adv-str dup sym-char? 0=
+    until
+    sym-addr sym-len ;
+
+: read-list ( str-addr str-len open-paren-char -- str-addr str-len non-paren-char mal-list )
+    \ push objects onto "dictionary" -- maybe not the best stack for this?
+    0 { len }
+    drop adv-str
+    begin ( str-addr str-len char )
+        skip-spaces ( str-addr str-len non-space-char )
+        dup [char] ) <>
+    while ( str-addr str-len non-space-non-paren-char )
+        read-form , len 1+ to len
+    repeat
+    drop adv-str
+
+    \ pop objects out of "dictionary" into MalList
+    mal-nil
+    len 0 ?do
+        0 cell - allot
+        here @ swap conj
+    loop
+    ;
+
+: read-form2 ( str-addr str-len char -- str-addr str-len mal-obj )
+    skip-spaces
+    dup mal-digit? if read-int else
+        dup [char] ( = if read-list else
+            read-symbol-str MalSymbol.
+        endif
+    endif
+    ;
+' read-form2 is read-form
+
+: read-str ( str-addr str-len - mal-obj )
+    over c@ read-form -rot 2drop ;