4 \
Drop a char off the
front of string by advancing the
addr and
5 \ decrementing the
length, and fetch next
char
6 : adv
-str
( str
-addr str
-len
-- str
-addr str
-len
char )
11 : mal
-digit
? ( char -- flag
)
18 : char-in-str
? ( char str
-addr str
-len
)
22 i c
@ needle
= if drop
true leave endif
25 : sym
-char? ( char -- flag
)
26 s
\" \n\r\t\000[]{}()'\"`,; " char-in-str? 0= ;
28 : skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char )
31 dup s\" \n\r\t, " char-in-str?
32 while ( str-addr str-len space-char )
38 adv-str s\" \n\r\000" char-in-str?
46 defer read-form ( str-addr str-len -- str-addr str-len mal-obj )
48 : read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int )
50 begin ( str-addr str-len digit-char )
51 [char] 0 - int 10 * + to int ( str-addr str-len )
52 adv-str dup mal-digit? 0= ( str-addr str-len digit-char )
56 : read-symbol-str ( str-addr str-len sym-char -- str-addr str-len char sym-addr sym-len )
57 new-str { sym-addr sym-len }
58 begin ( str-addr str-len sym-char )
59 sym-addr sym-len rot str-append-char to sym-len to sym-addr
60 adv-str dup sym-char? 0=
64 : read-string-literal ( in-addr in-len quote-char -- in-addr in-len mal-string )
65 new-str { out-addr out-len }
66 drop \ drop leading quote
67 begin ( in-addr in-len )
69 2drop 0 0 s\" expected '\"', got EOF" ...throw-str
75 dup [char] n = if drop 10 endif
76 dup [char] r = if drop 13 endif
78 out-addr out-len rot str-append-char to out-len to out-addr
80 drop adv-str \ skip trailing quote
81 out-addr out-len MalString. ;
83 : read-list ( str-addr str-len open-paren-char close-paren-char
84 -- str-addr str-len non-paren-char mal-list )
85 here { close-char old-here }
87 begin ( str-addr str-len char )
88 skip-spaces ( str-addr str-len non-space-char )
90 drop 2drop 0 0 s" ', got
EOF"
91 close-char pad ! pad 1
92 s" expected
'" ...throw-str
95 while ( str-addr str-len non-space-non-paren-char )
99 old-here here>MalList ;
101 s" deref" MalSymbol. constant deref-sym
102 s" quote" MalSymbol. constant quote-sym
103 s" quasiquote" MalSymbol. constant quasiquote-sym
104 s" splice-unquote" MalSymbol. constant splice-unquote-sym
105 s" unquote" MalSymbol. constant unquote-sym
107 : read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list )
109 , ( buf-addr buf-len char )
110 read-form , ( buf-addr buf-len char )
111 old-here here>MalList ;
113 : read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj )
115 dup mal-digit? if read-int else
116 dup [char] ( = if [char] ) read-list else
117 dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else
118 dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else
119 dup [char] " = if read-string-literal else
120 dup [char] : = if drop adv-str read-symbol-str MalKeyword. else
121 dup [char] @ = if drop adv-str deref-sym read-wrapped else
122 dup [char] ' = if drop adv
-str quote-sym read
-wrapped
else
123 dup
[char] `
= if drop adv
-str quasiquote-sym read
-wrapped
else
126 dup
[char] @ = if drop adv
-str splice-unquote-sym read
-wrapped
127 else unquote-sym read
-wrapped
132 read
-form
{ meta
} read
-form
{ obj
}
135 s
" with-meta" MalSymbol. swap
conj
138 2dup s
" true" str= if 2drop mal
-true
139 else 2dup s
" false" str= if 2drop mal
-false
140 else 2dup s
" nil" str= if 2drop mal
-nil
143 endif endif endif endif endif endif endif endif endif endif endif endif endif endif
;
144 ' read-form2 is read-form
146 : read-str ( str-addr str-len - mal-obj )
147 over c@ read-form { obj } drop 2drop obj ;