! cool! Also I'm stealing these unfold and linrec words for my utility file.
! But couldn't you have written the matching much simpler using "case" instead of "cond" ?
SYMBOLS: foo
->
<-
=>
<=
xy/
xy\ ;
: (x@eval) ( xy -- xy )
y-pop {
{ xy/ [ x-pop y-compose ] }
{ xy\ [ y-pop x-push ] }
{ -> [ x-pop >>y ] }
{ <- [ x-pop >>x ] }
{ => [ x-pop y-push-tail ] }
{ <= [ y-pop-tail x-push ] }
{ * [ x-pop2 * x-push ] }
{ + [ x-pop2 + x-push ] }
{ foo [ { 1 + foo } y-compose ] }
[ x-push ]
} case ;
:: @eval-word ( xy ast-word -- xy )
ast-word value>> {
{ [ dup "`" = ] [ drop xy x-pop dup ast-list? over ast-quot? or [ value>> first ] [ 1array ast-list boa ] if x-push ] }
{ "=>" [ xy x-pop y-push-tail ] }
{ "<=" [ xy y-pop-tail x-push ] }
{ "->" [ xy x-pop value>> >>y ] }
{ "<-" [ xy x-pop >>x ] }
{ "\\" [ xy y-pop x-push ] }
{ "/" [ xy x-pop value>> y-compose ] }
{ "+" [ xy x-pop2 [ value>> ] bi@ + ast-number boa x-push ] }
{ "-"[ xy x-pop2 [ value>> ] bi@ - ast-number boa x-push ] }
{ "*" [ xy x-pop2 [ value>> ] bi@ * ast-number boa x-push ] }
[ xy env>> at [ xy swap y-compose ] [ xy ast-word x-push ] if* ]
} case ;