factor/library/inference/kill-literals.factor

61 lines
1.5 KiB
Factor
Raw Normal View History

2005-08-07 00:00:57 -04:00
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: generic hashtables inference kernel lists
matrices namespaces sequences vectors ;
GENERIC: literals* ( node -- )
: literals ( node -- seq )
2005-08-25 15:27:38 -04:00
[ [ literals* ] each-node ] { } make ;
2005-08-07 00:00:57 -04:00
2005-08-29 21:00:39 -04:00
GENERIC: can-kill? ( literal node -- ? )
2005-08-07 00:00:57 -04:00
: kill-set ( node -- list )
#! Push a list of literals that may be killed in the IR.
2005-08-29 21:00:39 -04:00
dup literals [
swap [ can-kill? ] all-nodes-with?
] subset-with ;
2005-08-07 00:00:57 -04:00
: remove-values ( values node -- )
2dup [ node-in-d seq-diff ] keep set-node-in-d
2dup [ node-out-d seq-diff ] keep set-node-out-d
2dup [ node-in-r seq-diff ] keep set-node-in-r
[ node-out-r seq-diff ] keep set-node-out-r ;
GENERIC: kill-node* ( literals node -- )
M: node kill-node* ( literals node -- ) 2drop ;
: kill-node ( literals node -- )
[ 2dup kill-node* remove-values ] each-node-with ;
! Generic nodes
M: node literals* ( node -- ) drop ;
2005-08-29 21:00:39 -04:00
M: node can-kill? ( literal node -- ? ) uses-value? not ;
2005-08-07 00:00:57 -04:00
! #push
M: #push literals* ( node -- )
node-out-d % ;
2005-08-29 21:00:39 -04:00
M: #push can-kill? ( literal node -- ? ) 2drop t ;
2005-08-07 00:00:57 -04:00
M: #push kill-node* ( literals node -- )
[ node-out-d seq-diff ] keep set-node-out-d ;
2005-09-04 17:07:59 -04:00
! #shuffle
M: #shuffle can-kill? ( literal node -- ? ) 2drop t ;
2005-08-07 00:00:57 -04:00
! #call-label
2005-08-29 21:00:39 -04:00
M: #call-label can-kill? ( literal node -- ? ) 2drop t ;
2005-08-07 00:00:57 -04:00
! #values
2005-08-29 21:00:39 -04:00
M: #values can-kill? ( literal node -- ? ) 2drop t ;
2005-08-07 00:00:57 -04:00
! #merge
2005-08-29 21:00:39 -04:00
M: #merge can-kill? ( literal node -- ? ) 2drop t ;
2005-08-07 00:00:57 -04:00
! #entry
2005-08-29 21:00:39 -04:00
M: #entry can-kill? ( literal node -- ? ) 2drop t ;