The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
688fe55
)
Draft character atom implementation.
author
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 4 Jul 2016 22:15:56 +0000
(
00:15
+0200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 4 Jul 2016 22:15:56 +0000
(
00:15
+0200)
scheme.4th
patch
|
blob
|
history
diff --git
a/scheme.4th
b/scheme.4th
index
0bbfbf5
..
ea02cd5
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-18,7
+18,6
@@
variable stored-parse-idx
create parse-str 161 allot
variable parse-str-span
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 !
create parse-idx-stack 10 allot
variable parse-idx-sp
parse-idx-stack parse-idx-sp !
@@
-204,6
+203,19
@@
parse-idx-stack parse-idx-sp !
boolean-type
;
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 )
\ Parse a scheme expression
: read ( -- obj )
@@
-219,6
+231,11
@@
parse-idx-stack parse-idx-sp !
exit
then
exit
then
+ character? if
+ readchar
+ exit
+ then
+
eof? if
bold fg blue ." Moriturus te saluto." reset-term ." ok" cr
quit
eof? if
bold fg blue ." Moriturus te saluto." reset-term ." ok" cr
quit
@@
-258,10
+275,20
@@
parse-idx-stack parse-idx-sp !
then
;
then
;
+: printchar ( charobj -- )
+ drop
+ case
+ 9 of ." #\tab" endof
+ bl of ." #\space" endof
+ '\n' of ." #\newline" endof
+ endcase
+;
+
: print ( obj -- )
." ; "
number-type istype? if printnum exit then
boolean-type istype? if printbool exit then
: print ( obj -- )
." ; "
number-type istype? if printnum exit then
boolean-type istype? if printbool exit then
+ character-type istype? if printchar exit then
;
\ ---- REPL ----
;
\ ---- REPL ----