X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme.4th;h=8d9c97a8938a865d92ddf9326379fb027337ec3a;hb=bc4c866824b12208394e0ca8d6468ed8cd5c49a8;hp=4f5313b3d5c5552eff2841d8ef3f451dc9d60159;hpb=24acc44c999a869d56c734b5e30fae16d6c516c6;p=scheme.forth.jl.git

diff --git a/scheme.4th b/scheme.4th
index 4f5313b..8d9c97a 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -7,6 +7,7 @@ include term-colours.4th
 
 0 constant number-type
 1 constant boolean-type
+2 constant character-type
 : istype? ( obj -- obj b )
     over = ;
 
@@ -15,6 +16,12 @@ include term-colours.4th
 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 !  ;
 
@@ -50,7 +57,7 @@ variable parse-str
     begin
         whitespace?
     while
-            1 parse-idx +!
+        inc-parse-idx
     repeat
 ;
 
@@ -69,10 +76,10 @@ variable parse-str
     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
@@ -87,26 +94,42 @@ variable parse-str
 : 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
@@ -115,7 +138,7 @@ variable parse-str
 ;
 
 : readbool ( -- bool-atom )
-    1 parse-idx +!
+    inc-parse-idx
     
     nextchar [char] f = if
         false
@@ -166,6 +189,7 @@ variable parse-str
 \ ---- Print ----
 
 : printnum ( numobj -- ) drop . ;
+
 : printbool ( numobj -- )
     drop if
         ." #t"
@@ -175,9 +199,9 @@ variable parse-str
 ;
 
 : 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 ----
@@ -186,7 +210,7 @@ create repl-buffer 161 allot
 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
@@ -198,11 +222,11 @@ repl-buffer parse-str !
        ." 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