include term-colours.4th
include defer-is.4th
include catch-throw.4th
+include integer.4th
include float.4th
include debugging.4th
make-type fixnum-type
make-type flonum-type
+make-type ratnum-type
make-type boolean-type
make-type character-type
make-type string-type
pop-parse-idx
;
+: ratnum? ( -- bool )
+ push-parse-idx
+
+ minus? plus? or if
+ inc-parse-idx
+ then
+
+ digit? invert if
+ pop-parse-idx false exit
+ else
+ inc-parse-idx
+ then
+
+ begin digit? while
+ inc-parse-idx
+ repeat
+
+ [char] / nextchar <> if
+ pop-parse-idx false exit
+ else
+ inc-parse-idx
+ then
+
+ digit? invert if
+ pop-parse-idx false exit
+ else
+ inc-parse-idx
+ then
+
+ begin digit? while
+ inc-parse-idx
+ repeat
+
+ delim? pop-parse-idx
+;
+
: boolean? ( -- bool )
nextchar [char] # <> if false exit then
;
: readflonum ( -- flonum )
- \ DRAFT!!!
- readfixnum drop i->f
+ readfixnum drop
+ dup 0< swap abs i->f
+
+ [char] . nextchar = if
+ inc-parse-idx
+
+ 10.0 ( f exp )
- [char] . netchar = if
- 10 i->f
begin digit? while
- nextchar [char] 0 - i->f over f/ f+
+ nextchar [char] 0 - i->f ( f exp d )
+ over f/ rot f+ ( exp f' )
+ swap 10.0 f* ( f' exp' )
inc-parse-idx
repeat
+
+ drop
then
[char] e nextchar = [char] E nextchar = or if
+ inc-parse-idx
+ 10.0
readfixnum drop i->f
- f^
+ f^ f*
+ then
+
+ swap if
+ -1.0 f*
then
flonum-type
;
+: make-rational ( fixnum fixnum -- ratnum|fixnum )
+ drop swap drop
+ simplify
+
+ dup 1 = if
+ drop fixnum-type
+ else
+ fixnum-type swap fixnum-type
+ cons drop ratnum-type
+ then
+;
+
+: readratnum ( -- ratnum )
+ readfixnum inc-parse-idx readfixnum
+ make-rational
+;
+
: readbool ( -- bool-obj )
inc-parse-idx
exit
then
+ flonum? if
+ readflonum
+ exit
+ then
+
+ ratnum? if
+ readratnum
+ exit
+ then
+
boolean? if
readbool
exit
: self-evaluating? ( obj -- obj bool )
boolean-type istype? if true exit then
fixnum-type istype? if true exit then
+ flonum-type istype? if true exit then
+ ratnum-type istype? if true exit then
character-type istype? if true exit then
string-type istype? if true exit then
nil-type istype? if true exit then
\ ---- Print ---- {{{
-: printfixnum ( fixnumobj -- ) drop 0 .R ;
+: printfixnum ( fixnum -- ) drop 0 .R ;
+
+: printflonum ( flonum -- ) drop f. ;
+
+: printratnum ( ratnum -- )
+ drop pair-type 2dup
+ car print ." /" cdr print
+;
-: printbool ( numobj -- )
+: printbool ( bool -- )
drop if
." #t"
else
:noname ( obj -- )
fixnum-type istype? if printfixnum exit then
+ flonum-type istype? if printflonum exit then
+ ratnum-type istype? if printratnum exit then
boolean-type istype? if printbool exit then
character-type istype? if printchar exit then
string-type istype? if printstring exit then