Loop conversion work in progress

db4
Slava Pestov 2008-02-14 15:17:01 -06:00
parent 984aaa2544
commit f8c99c864b
2 changed files with 55 additions and 29 deletions

View File

@ -135,15 +135,6 @@ M: #call-label detect-loops*
r> [ set-node-successor ] keep ;
! ! ! Lifting code after a conditional if one branch throws
: only-one ( seq -- elt/f )
dup length 1 = [ first ] [ drop f ] if ;
: lift-throw-tail? ( #if -- tail/? )
dup node-successor #tail?
[ drop f ] [ active-children only-one ] if ;
: clone-node ( node -- newnode )
clone dup [ clone ] modify-values ;
! BEFORE
!
@ -177,7 +168,17 @@ M: #call-label detect-loops*
! the same node as (***)
!
! Note: if (**) is #return is is sound to put #terminate there,
! but not if (**) is #values
! but not if (**) is #
: only-one ( seq -- elt/f )
dup length 1 = [ first ] [ drop f ] if ;
: lift-throw-tail? ( #if -- tail/? )
dup node-successor #tail?
[ drop f ] [ active-children only-one ] if ;
: clone-node ( node -- newnode )
clone dup [ clone ] modify-values ;
: lift-branch
over
@ -196,20 +197,6 @@ M: #if optimize-node*
] if
] if ;
: fold-dispatch-branch? dup node-in-d first tuck node-literal? ;
: fold-dispatch-branch ( node value -- node' )
dupd node-literal
over drop-inputs >r fold-branch r>
[ set-node-successor ] keep ;
M: #dispatch optimize-node*
dup fold-dispatch-branch? [
fold-dispatch-branch t
] [
2drop t f
] if ;
! Loop tail hoising: code after a loop can sometimes go in the
! non-recursive branch of the loop
@ -247,6 +234,27 @@ M: #dispatch optimize-node*
! |
! #return 1
: find-tail
dup node-successor #tail?
[ node-successor find-tail ] unless ;
: child-tails ( node -- seq )
node-children [ find-tail ] map ;
GENERIC: add-loop-exit* ( label node -- )
M: #branch add-loop-exit*
child-tails [ add-loop-exit* ] with each ;
M: #call-label add-loop-exit* drop ;
M: node add-loop-exit* node-successor add-loop-exit* , ;
: find-loop-exits ( label node -- seq )
[ add-loop-exit* ] { } make ;
! ! ! !
: find-final-if ( node -- #if/f )
dup [
dup #if? [
@ -264,11 +272,7 @@ M: #dispatch optimize-node*
: lift-loop-tail? ( #label -- tail/f )
dup node-successor node-successor [
dup node-param swap node-child find-final-if dup [
node-children [ penultimate-node ] map
[
dup #call-label?
[ node-param eq? not ] [ 2drop t ] if
] with subset only-one
find-loop-exits only-one
] [ 2drop f ] if
] [ drop f ] if ;

View File

@ -329,3 +329,25 @@ TUPLE: silly-tuple a b ;
10 [ ] lift-loop-tail-test-1 1 2 3 ;
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
! Make sure we don't lose
GENERIC: generic-inline-test ( x -- y )
M: integer generic-inline-test ;
: generic-inline-test-1
1
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test
generic-inline-test ;
[ { t f } ] [
\ generic-inline-test-1 word-def dataflow
[ optimize-1 , optimize-1 , drop ] { } make
] unit-test