0 constant number-type
1 constant boolean-type
+2 constant character-type
: istype? ( obj -- obj b )
over = ;
variable parse-idx
variable dummy-parse-idx
+: inc-parse-idx
+ 1 parse-idx +! ;
+
+: dec-parse-idx
+ 1 parse-idx -! ;
+
: store-parse-idx
parse-idx @ dummy-parse-idx ! ;
begin
whitespace?
while
- 1 parse-idx +!
+ inc-parse-idx
repeat
;
then
store-parse-idx
- 1 parse-idx +!
+ inc-parse-idx
begin digit? while
- 1 parse-idx +!
+ inc-parse-idx
repeat
delim? charavailable? false = or if
: boolean? ( -- bool )
nextchar [char] # <> if false exit then
- 1 parse-idx +!
+ store-parse-idx
+ inc-parse-idx
nextchar [char] t <>
nextchar [char] f <>
- and if 1 parse-idx -! false exit then
+ and if restore-parse-idx false exit then
- 1 parse-idx -!
+ restore-parse-idx
true
;
+: character? ( -- bool )
+ nextchar [char] # <> if false exit then
+
+ store-parse-idx
+ inc-parse-idx
+
+ nextchar [char] \ <> if restore-parse-idx false exit then
+
+ inc-parse-idx
+
+ charavailable? false = if restore-parse-idx false exit then
+
+ restore-parse-idx true
+;
+
: readnum ( -- num-atom )
minus? dup if
- 1 parse-idx +!
+ inc-parse-idx
then
0
begin digit? while
10 * nextchar [char] 0 - +
- 1 parse-idx +!
+ inc-parse-idx
repeat
swap if negate then
;
: readbool ( -- bool-atom )
- 1 parse-idx +!
+ inc-parse-idx
nextchar [char] f = if
false
\ ---- Print ----
: printnum ( numobj -- ) drop . ;
+
: printbool ( numobj -- )
drop if
." #t"
;
: print ( obj -- )
- ." ;"
- number-type istype? if printnum exit then
- boolean-type istype? if printbool exit then
+ ." ; "
+ number-type istype? if ." => " printnum exit then
+ boolean-type istype? if ." => " printbool exit then
;
\ ---- REPL ----
repl-buffer parse-str !
: getline
- repl-buffer 1+ 160 expect cr span @ repl-buffer ! ;
+ repl-buffer 1+ 160 expect span @ repl-buffer ! ;
: eof?
repl-buffer @ 0= if false exit then
." Use Ctrl-D to exit." cr
begin
- cr bold fg green ." => " reset-term
+ cr bold fg green ." > " reset-term
getline
eof? if
- bold fg blue ." Moriturus te saluto." reset-term
+ cr bold fg blue ." Moriturus te saluto." reset-term
exit
then