Loop conversion work in progress
parent
984aaa2544
commit
f8c99c864b
|
@ -135,15 +135,6 @@ M: #call-label detect-loops*
|
||||||
r> [ set-node-successor ] keep ;
|
r> [ set-node-successor ] keep ;
|
||||||
|
|
||||||
! ! ! Lifting code after a conditional if one branch throws
|
! ! ! 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
|
! BEFORE
|
||||||
!
|
!
|
||||||
|
@ -177,7 +168,17 @@ M: #call-label detect-loops*
|
||||||
! the same node as (***)
|
! the same node as (***)
|
||||||
!
|
!
|
||||||
! Note: if (**) is #return is is sound to put #terminate there,
|
! 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
|
: lift-branch
|
||||||
over
|
over
|
||||||
|
@ -196,20 +197,6 @@ M: #if optimize-node*
|
||||||
] if
|
] if
|
||||||
] 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
|
! Loop tail hoising: code after a loop can sometimes go in the
|
||||||
! non-recursive branch of the loop
|
! non-recursive branch of the loop
|
||||||
|
|
||||||
|
@ -247,6 +234,27 @@ M: #dispatch optimize-node*
|
||||||
! |
|
! |
|
||||||
! #return 1
|
! #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 )
|
: find-final-if ( node -- #if/f )
|
||||||
dup [
|
dup [
|
||||||
dup #if? [
|
dup #if? [
|
||||||
|
@ -264,11 +272,7 @@ M: #dispatch optimize-node*
|
||||||
: lift-loop-tail? ( #label -- tail/f )
|
: lift-loop-tail? ( #label -- tail/f )
|
||||||
dup node-successor node-successor [
|
dup node-successor node-successor [
|
||||||
dup node-param swap node-child find-final-if dup [
|
dup node-param swap node-child find-final-if dup [
|
||||||
node-children [ penultimate-node ] map
|
find-loop-exits only-one
|
||||||
[
|
|
||||||
dup #call-label?
|
|
||||||
[ node-param eq? not ] [ 2drop t ] if
|
|
||||||
] with subset only-one
|
|
||||||
] [ 2drop f ] if
|
] [ 2drop f ] if
|
||||||
] [ drop f ] if ;
|
] [ drop f ] if ;
|
||||||
|
|
||||||
|
|
|
@ -329,3 +329,25 @@ TUPLE: silly-tuple a b ;
|
||||||
10 [ ] lift-loop-tail-test-1 1 2 3 ;
|
10 [ ] lift-loop-tail-test-1 1 2 3 ;
|
||||||
|
|
||||||
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
|
[ 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
|
||||||
|
|
Loading…
Reference in New Issue