: type@ ( objvar -- type ) 1+ @ ;
: value! ( newval objvar -- ) ! ;
: type! ( newtype objvar -- ) 1+ ! ;
: type@ ( objvar -- type ) 1+ @ ;
: value! ( newval objvar -- ) ! ;
: type! ( newtype objvar -- ) 1+ ! ;
+: duplicate-charlist ( charlist -- copy )
+ 2dup nil objeq? false = if
+ 2dup car 2swap cdr recurse cons
+ then ;
+
+: 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 obj@
+
+ 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 obj@ cons
+ symbol-table obj!
+;
+
+
create-symbol set! set!-symbol
create-symbol ok ok-symbol
create-symbol if if-symbol
create-symbol set! set!-symbol
create-symbol ok ok-symbol
create-symbol if if-symbol
character-type istype? if true exit then
string-type istype? if true exit then
nil-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
+: lambda? ( obj -- obj bool )
+ lambda-symbol tagged-list? ;
+
+: lambda-parameters ( obj -- params )
+ cdr car ;
+
+: lambda-body ( obj -- body )
+ cdr cdr ;
+
+: make-procedure ( params body env -- proc )
+ nil
+ cons cons cons
+ drop compound-proc-type
+;
+
boolean-type istype? if printbool exit then
character-type istype? if printchar exit then
string-type istype? if printstring exit then
symbol-type istype? if printsymbol exit then
nil-type istype? if printnil exit then
pair-type istype? if ." (" printpair ." )" exit then
boolean-type istype? if printbool exit then
character-type istype? if printchar exit then
string-type istype? if printstring exit then
symbol-type istype? if printsymbol exit then
nil-type istype? if printnil exit then
pair-type istype? if ." (" printpair ." )" exit then