create-symbol define define-symbol
create-symbol set! set!-symbol
create-symbol ok ok-symbol
+create-symbol if if-symbol
\ }}}
: add-binding ( var val frame -- )
2swap 2over frame-vals cons
- 2over set-car!
+ 2over set-cdr!
2swap 2over frame-vars cons
- swap set-cdr!
+ 2swap set-car!
;
: extend-env ( vars vals env -- env )
get-vars-vals if
2swap 2drop car
else
- bold fg red ." Tried to read unbound variable." reset-term abort
+ bold fg red ." Tried to read unbound variable." reset-term cr abort
then
;
2swap 2drop ( val vals )
set-car!
else
- bold fg red ." Tried to set unbound variable." reset-term abort
+ bold fg red ." Tried to set unbound variable." reset-term cr abort
then
;
\ ---- Eval ---- {{{
+defer eval
+
: self-evaluating? ( obj -- obj bool )
boolean-type istype? if true exit then
number-type istype? if true exit then
: assignment-val ( obj -- val )
cdr cdr car ;
-defer eval
-
: eval-definition ( obj env -- res )
2swap
2over 2over ( env obj env obj )
ok-symbol
;
+: if? ( obj -- obj bool )
+ if-symbol tagged-list? ;
+
+: if-predicate ( ifobj -- pred )
+ cdr car ;
+
+: if-consequent ( ifobj -- conseq )
+ cdr cdr car ;
+
+: if-alternative ( ifobj -- alt|false )
+ cdr cdr cdr
+ 2dup nil objeq? if
+ 2drop false
+ else
+ car
+ then ;
+
+: false? ( boolobj -- boolean )
+ boolean-type istype? if
+ false boolean-type objeq?
+ else
+ 2drop false
+ then
+;
+
+: true? ( boolobj -- boolean )
+ false? invert ;
+
:noname ( obj env -- result )
2swap
exit
then
+ if? if
+ 2over 2over
+ if-predicate
+ 2swap eval
+
+ true? if
+ if-consequent
+ else
+ if-alternative
+ then
+
+ 2swap ['] eval goto
+ then
+
bold fg red ." Error evaluating expression - unrecognized type. Aborting." reset-term cr
abort
; is eval
;
forth definitions
+
+\ vim:fdm=marker