6 include term-colours.4th
9 1 constant boolean-type
10 2 constant character-type
11 : istype? ( obj -- obj b )
17 variable stored-parse-idx
18 create parse-str 161 allot
19 variable parse-str-span
22 '\n' parse-str parse-str-span @ + !
30 parse-str 160 expect cr
31 span @ parse-str-span !
42 parse-idx @ stored-parse-idx ! ;
45 stored-parse-idx @ parse-idx ! ;
47 : charavailable? ( -- bool )
48 parse-str-span @ parse-idx @ > ;
50 : nextchar ( -- char )
51 charavailable? false = if getline then
52 parse-str parse-idx @ + @ ;
54 : whitespace? ( -- bool )
63 nextchar [char] ( = or
64 nextchar [char] ) = or
84 digit? minus? or false = if
96 delim? charavailable? false = or if
105 : boolean? ( -- bool )
106 nextchar [char] # <> if false exit then
113 and if restore-parse-idx false exit then
119 : character? ( -- bool )
120 nextchar [char] # <> if false exit then
125 nextchar [char] \ <> if restore-parse-idx false exit then
129 charavailable? false = if restore-parse-idx false exit then
131 restore-parse-idx true
134 : readnum ( -- num-atom )
142 10 * nextchar [char] 0 - +
151 : readbool ( -- bool-atom )
154 nextchar [char] f = if
165 \ Parse a scheme expression
181 bold fg blue ." Moriturus te saluto." reset-term ." ok" cr
185 bold fg red ." Error parsing string starting at character '"
187 ." '. Aborting." reset-term cr
193 : self-evaluating? ( obj -- obj bool )
194 number-type istype? if true exit then
195 boolean-type istype? if true exit then
203 bold fg red ." Error evaluating expression - unrecognized type. Aborting." reset-term cr
209 : printnum ( numobj -- ) drop . ;
211 : printbool ( numobj -- )
221 number-type istype? if printnum exit then
222 boolean-type istype? if printbool exit then
228 cr ." Welcome to scheme.forth.jl!" cr
229 ." Use Ctrl-D to exit." cr
234 cr bold fg green ." > " reset-term
237 fg cyan print reset-term