From: Tim Vaughan Date: Tue, 21 Jun 2016 21:21:27 +0000 (+1200) Subject: Booleans implemented. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=24acc44c999a869d56c734b5e30fae16d6c516c6;p=scheme.forth.jl.git Booleans implemented. --- diff --git a/scheme.4th b/scheme.4th index 061d36d..4f5313b 100644 --- a/scheme.4th +++ b/scheme.4th @@ -6,6 +6,7 @@ scheme definitions include term-colours.4th 0 constant number-type +1 constant boolean-type : istype? ( obj -- obj b ) over = ; @@ -83,6 +84,19 @@ variable parse-str then ; +: boolean? ( -- bool ) + nextchar [char] # <> if false exit then + + 1 parse-idx +! + + nextchar [char] t <> + nextchar [char] f <> + and if 1 parse-idx -! false exit then + + 1 parse-idx -! + true +; + : readnum ( -- num-atom ) minus? dup if 1 parse-idx +! @@ -100,41 +114,72 @@ variable parse-str number-type ; +: readbool ( -- bool-atom ) + 1 parse-idx +! + + nextchar [char] f = if + false + else + true + then + + boolean-type +; + \ Parse a counted string into a scheme expression : read ( -- obj ) eatspaces + number? if readnum exit then - ." Error parsing string at character" parse-idx ? ." . Aborting." cr + boolean? if + readbool + exit + then + + bold fg red ." Error parsing string starting at character '" + nextchar emit + ." '. Aborting." reset-term cr abort ; \ ---- Eval ---- : self-evaluating? ( obj -- obj bool ) - number-type istype? ; + number-type istype? if true exit then + boolean-type istype? if true exit then + false ; : eval self-evaluating? if exit then - ." Error evaluating expression - unrecognized type. Aborting." cr + bold fg red ." Error evaluating expression - unrecognized type. Aborting." reset-term cr abort ; \ ---- Print ---- -: print ( obj -- ) - number-type istype? if - drop . +: printnum ( numobj -- ) drop . ; +: printbool ( numobj -- ) + drop if + ." #t" + else + ." #f" then ; +: print ( obj -- ) + ." ;" + number-type istype? if printnum exit then + boolean-type istype? if printbool exit then +; + \ ---- REPL ---- create repl-buffer 161 allot @@ -157,7 +202,7 @@ repl-buffer parse-str ! getline eof? if - fg blue ." Moriturus te saluto." reset-term + bold fg blue ." Moriturus te saluto." reset-term exit then @@ -165,7 +210,7 @@ repl-buffer parse-str ! 0 parse-idx ! read eval - print + fg cyan print reset-term then again ; diff --git a/term-colours.4th b/term-colours.4th index 1d87c8e..5c08a00 100644 --- a/term-colours.4th +++ b/term-colours.4th @@ -14,6 +14,11 @@ escape [char] 0 emit escape-end ; +: clear-term + escape [char] 2 emit [char] J emit + escape [char] 0 emit [char] ; emit [char] 0 emit [char] f emit +; + : bold escape [char] 1 emit escape-end ;