Clean up tail call optimization

db4
Slava Pestov 2008-02-12 17:32:17 -06:00
parent 0900c0e6cd
commit 7c6999872a
2 changed files with 18 additions and 24 deletions

View File

@ -82,25 +82,6 @@ GENERIC: generate-node ( node -- next )
: if-intrinsics ( #call -- quot )
node-param "if-intrinsics" word-prop ;
DEFER: #terminal?
PREDICATE: #merge #terminal-merge node-successor #terminal? ;
PREDICATE: #values #terminal-values node-successor #terminal? ;
PREDICATE: #call #terminal-call
dup node-successor #if?
over node-successor node-successor #terminal? and
swap if-intrinsics and ;
UNION: #terminal
POSTPONE: f #return #terminal-values #terminal-merge ;
: tail-call? ( -- ? )
node-stack get [
dup #terminal-call? swap node-successor #terminal? or
] all? ;
! node
M: node generate-node drop iterate-next ;
@ -224,10 +205,11 @@ M: #dispatch generate-node
: define-if-intrinsic ( word quot inputs -- )
2array 1array define-if-intrinsics ;
: do-if-intrinsic ( #call pair -- next )
<label> [ swap do-template ] keep
>r node-successor r> generate-if
node-successor ;
: do-if-intrinsic ( pair -- next )
<label> [
swap do-template
node> node-successor dup >node
] keep generate-if ;
: find-intrinsic ( #call -- pair/f )
intrinsics find-template ;
@ -249,7 +231,7 @@ M: #call generate-node
] [
node-param generate-call
] ?if
] if* ;
] ?if ;
! #call-label
M: #call-label generate-node node-param generate-call ;

View File

@ -304,3 +304,15 @@ SYMBOL: node-stack
node-children
[ last-node ] map
[ #terminate? not ] subset ;
DEFER: #tail?
PREDICATE: #merge #tail-merge node-successor #tail? ;
PREDICATE: #values #tail-values node-successor #tail? ;
UNION: #tail
POSTPONE: f #return #tail-values #tail-merge ;
: tail-call? ( -- ? )
node-stack get [ node-successor #tail? ] all? ;