4 constant nil-type
5 constant pair-type
6 constant symbol-type
-: istype? ( obj -- obj b )
+: istype? ( obj type -- obj bool )
over = ;
\ ------ Memory ------
;
: nil 0 nil-type ;
+: nil? nil-type istype? ;
: objvar create 0 , 0 , ;
cons
;
+: charlist-equiv ( charlist charlist -- bool )
+
+ 2over 2over
+
+ \ One or both nil
+ nil? -rot 2drop
+ if
+ nil? -rot 2drop
+ if
+ 2drop 2drop true exit
+ else
+ 2drop 2drop false exit
+ then
+ else
+ nil? -rot 2drop
+ if
+ 2drop 2drop false exit
+ then
+ then
+
+ 2over 2over
+
+ \ Neither nil
+ car drop -rot car drop = if
+ cdr 2swap cdr recurse
+ else
+ 2drop 2drop false
+ then
+;
+
+: charlist>symbol ( charlist -- symbol-obj )
+
+ symbol-table fetchobj
+
+ begin
+ nil? false =
+ while
+ 2over 2over
+ car drop pair-type
+ charlist-equiv if
+ 2swap 2drop
+ car
+ exit
+ else
+ cdr
+ then
+ repeat
+
+ 2drop
+ drop symbol-type 2dup
+ symbol-table fetchobj cons
+ symbol-table setobj
+;
+
defer read
-: readpair ( -- obj )
+: readpair ( -- pairobj )
eatspaces
\ Empty lists
then
symbol? if
- readsymbol
- drop symbol-type
- 2dup
- symbol-table fetch
- cons
- symbol-table set
+ readsymbol charlist>symbol
exit
then