: objeq? ( obj obj -- bool )
rot = -rot = and ;
+: 2rot ( a1 a2 b1 b2 c1 c2 -- b1 b2 c1 c2 a1 a2 )
+ >R >R ( a1 a2 b1 b2 )
+ 2swap ( b1 b2 a1 a2 )
+ R> R> ( b1 b2 a1 a2 c1 c2 )
+ 2swap
+;
+
+: -2rot ( a1 a2 b1 b2 c1 c2 -- c1 c2 a1 a2 b1 b2 )
+ 2swap ( a1 a2 c1 c2 b1 b2 )
+ >R >R ( a1 a2 c1 c2 )
+ 2swap ( c1 c2 a1 a2 )
+ R> R>
+;
+
\ }}}
\ ---- Pre-defined symbols ---- {{{
create-symbol define define-symbol
create-symbol set! set!-symbol
create-symbol ok ok-symbol
+create-symbol if if-symbol
\ }}}
\ ---- 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 )
2swap definition-var 2swap ( env var val )
- >R >R 2swap R> R> 2swap ( var val env )
+ 2rot ( var val env )
define-var
ok-symbol
2swap assignment-var 2swap ( env var val )
- >R >R 2swap R> R> 2swap ( var val env )
+ 2rot ( var val env )
set-var
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