fix problem in optimizer
parent
1d7b548386
commit
ec0bbe7e2d
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2004, 2005 Slava Pestov.
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: compiler-frontend
|
IN: compiler-frontend
|
||||||
USING: hashtables inference kernel lists namespaces sequences ;
|
USING: generic hashtables inference kernel lists matrices
|
||||||
|
namespaces sequences ;
|
||||||
|
|
||||||
! The optimizer transforms dataflow IR to dataflow IR. Currently
|
! The optimizer transforms dataflow IR to dataflow IR. Currently
|
||||||
! it removes literals that are eventually dropped, and never
|
! it removes literals that are eventually dropped, and never
|
||||||
|
|
@ -125,7 +126,7 @@ M: #drop useless-node? ( node -- ? )
|
||||||
|
|
||||||
! #call
|
! #call
|
||||||
M: #call can-kill* ( literal node -- ? )
|
M: #call can-kill* ( literal node -- ? )
|
||||||
nip node-param {{
|
dup node-param {{
|
||||||
[[ dup t ]]
|
[[ dup t ]]
|
||||||
[[ drop t ]]
|
[[ drop t ]]
|
||||||
[[ swap t ]]
|
[[ swap t ]]
|
||||||
|
|
@ -133,9 +134,10 @@ M: #call can-kill* ( literal node -- ? )
|
||||||
[[ pick t ]]
|
[[ pick t ]]
|
||||||
[[ >r t ]]
|
[[ >r t ]]
|
||||||
[[ r> t ]]
|
[[ r> t ]]
|
||||||
}} hash ;
|
}} hash >r delegate can-kill* r> or ;
|
||||||
|
|
||||||
: kill-mask ( killing inputs -- mask )
|
: kill-mask ( killing node -- mask )
|
||||||
|
dup node-param \ r> = [ node-in-r ] [ node-in-d ] ifte
|
||||||
[ swap memq? ] map-with ;
|
[ swap memq? ] map-with ;
|
||||||
|
|
||||||
: (kill-shuffle) ( word -- map )
|
: (kill-shuffle) ( word -- map )
|
||||||
|
|
@ -159,13 +161,13 @@ M: #call can-kill* ( literal node -- ? )
|
||||||
}} hash ;
|
}} hash ;
|
||||||
|
|
||||||
: lookup-mask ( mask word -- word )
|
: lookup-mask ( mask word -- word )
|
||||||
over [ not ] all? [ nip ] [ (kill-shuffle) hash ] ifte ;
|
over disj [ (kill-shuffle) hash ] [ nip ] ifte ;
|
||||||
|
|
||||||
: kill-shuffle ( literals node -- )
|
: kill-shuffle ( literals node -- )
|
||||||
#! If certain values passing through a stack op are being
|
#! If certain values passing through a stack op are being
|
||||||
#! killed, the stack op can be reduced, in extreme cases
|
#! killed, the stack op can be reduced, in extreme cases
|
||||||
#! to a no-op.
|
#! to a no-op.
|
||||||
[ [ node-in-d kill-mask ] keep node-param lookup-mask ] keep
|
[ [ kill-mask ] keep node-param lookup-mask ] keep
|
||||||
set-node-param ;
|
set-node-param ;
|
||||||
|
|
||||||
M: #call kill-node* ( literals node -- )
|
M: #call kill-node* ( literals node -- )
|
||||||
|
|
|
||||||
|
|
@ -21,9 +21,9 @@ USE: sequences
|
||||||
|
|
||||||
[ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
|
[ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
|
||||||
|
|
||||||
[ [ t t f ] ] [ [ 1 2 3 ] [
|
[ [ t t f ] ] [
|
||||||
f <literal> ] map
|
[ 1 2 3 ] [ f <literal> ] map
|
||||||
[ [ literal-value 2 <= ] subset ] keep kill-mask
|
[ [ literal-value 2 <= ] subset ] keep in-d-node <#drop> kill-mask
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
|
|
@ -69,3 +69,7 @@ USE: sequences
|
||||||
|
|
||||||
[ [ 5 [ dup ] [ dup ] ] ] [ \ literal-kill-test-6 word-def kill-set* ] unit-test
|
[ [ 5 [ dup ] [ dup ] ] ] [ \ literal-kill-test-6 word-def kill-set* ] unit-test
|
||||||
|
|
||||||
|
: literal-kill-test-7
|
||||||
|
[ 1 2 3 ] >r + r> drop ; compiled
|
||||||
|
|
||||||
|
[ 4 ] [ 2 2 literal-kill-test-7 ] unit-test
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue