create parse-str 161 allot
variable parse-str-span
-
create parse-idx-stack 10 allot
variable parse-idx-sp
parse-idx-stack parse-idx-sp !
inc-parse-idx
repeat
- delim? charavailable? false = or if
+ delim? if
pop-parse-idx
true
else
nextchar [char] f <>
and if pop-parse-idx false exit then
- pop-parse-idx
- true
+ inc-parse-idx
+ delim? if
+ pop-parse-idx
+ true
+ else
+ pop-parse-idx
+ false
+ then
;
: str-equiv? ( str -- bool )
+
push-parse-idx
- true
+ true -rot
swap dup rot + swap
+
do
i @ nextchar <> if
drop false
inc-parse-idx
loop
- delim? <> if drop false then
+ delim? false = if drop false then
pop-parse-idx
;
boolean-type
;
+: readchar ( -- char-atom )
+ inc-parse-idx
+ inc-parse-idx
+
+ S" newline" str-equiv? if '\n' character-type exit then
+ S" space" str-equiv? if bl character-type exit then
+ S" tab" str-equiv? if 9 character-type exit then
+
+ nextchar character-type
+
+ inc-parse-idx
+;
+
\ Parse a scheme expression
: read ( -- obj )
exit
then
+ character? if
+ readchar
+ exit
+ then
+
eof? if
bold fg blue ." Moriturus te saluto." reset-term ." ok" cr
quit
: self-evaluating? ( obj -- obj bool )
number-type istype? if true exit then
boolean-type istype? if true exit then
+ character-type istype? if true exit then
false ;
: eval
then
;
+: printchar ( charobj -- )
+ drop
+ case
+ 9 of ." #\tab" endof
+ bl of ." #\space" endof
+ '\n' of ." #\newline" endof
+
+ ." #\" emit
+ endcase
+
+ trace
+;
+
: print ( obj -- )
." ; "
number-type istype? if printnum exit then
boolean-type istype? if printbool exit then
+ character-type istype? if printchar exit then
;
\ ---- REPL ----