factor/library/inference/kill-literals.factor

87 lines
2.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.
2005-09-09 00:17:19 -04:00
IN: optimizer
USING: arrays generic hashtables inference kernel math
namespaces sequences ;
: node-union ( node quot -- hash | quot: node -- )
2005-09-17 04:15:05 -04:00
[
swap [ swap call [ dup set ] each ] each-node-with
] make-hash ; inline
2005-08-07 00:00:57 -04:00
2005-09-17 04:15:05 -04:00
GENERIC: literals* ( node -- seq )
2005-08-07 00:00:57 -04:00
: literals ( node -- hash )
[ literals* ] node-union ;
2005-09-17 04:15:05 -04:00
GENERIC: live-values* ( node -- seq )
2005-08-07 00:00:57 -04:00
: live-values ( node -- hash )
#! All values that are returned or passed to calls.
[ live-values* ] node-union ;
2005-09-07 17:21:11 -04:00
GENERIC: returns* ( node -- )
: returns ( node -- seq )
#! Trace all control flow paths, build a hash of
#! final #return nodes.
[ returns* ] @{ }@ make ;
M: f returns* drop ;
2005-08-07 00:00:57 -04:00
: kill-set ( node -- hash )
2005-08-07 00:00:57 -04:00
#! Push a list of literals that may be killed in the IR.
dup live-values swap literals hash-diff ;
2005-08-07 00:00:57 -04:00
: remove-values ( values node -- )
2dup [ node-in-d remove-all ] keep set-node-in-d
2dup [ node-out-d remove-all ] keep set-node-out-d
2dup [ node-in-r remove-all ] keep set-node-in-r
[ node-out-r remove-all ] keep set-node-out-r ;
2005-08-07 00:00:57 -04:00
: kill-node ( values node -- )
2005-09-17 04:15:05 -04:00
over hash-size 0 >
[ [ remove-values ] each-node-with ] [ 2drop ] ifte ;
2005-08-07 00:00:57 -04:00
! Generic nodes
2005-09-17 04:15:05 -04:00
M: node literals* ( node -- ) drop @{ }@ ;
2005-08-07 00:00:57 -04:00
2005-09-17 04:15:05 -04:00
M: node live-values* ( node -- ) node-values ;
2005-09-16 22:47:28 -04:00
M: node returns* ( node -- seq ) node-successor returns* ;
2005-08-07 00:00:57 -04:00
2005-09-04 17:07:59 -04:00
! #shuffle
2005-09-17 04:15:05 -04:00
M: #shuffle literals* ( node -- seq )
dup node-out-d swap node-out-r
[ [ literal? ] subset ] 2apply append ;
2005-09-07 17:21:11 -04:00
! #return
M: #return returns* , ;
2005-09-17 04:15:05 -04:00
M: #return live-values* ( node -- seq )
#! Values returned by local labels can be killed.
2005-09-17 04:15:05 -04:00
dup node-param [ drop @{ }@ ] [ delegate live-values* ] ifte ;
! nodes that don't use their input values directly
2005-09-17 04:15:05 -04:00
UNION: #killable #shuffle #call-label #merge #values ;
M: #killable live-values* ( node -- seq ) drop @{ }@ ;
2005-09-17 04:15:05 -04:00
! #entry
M: #entry live-values* ( node -- seq )
#! The live values are those which appear in the in-d but
#! not in the out-d. These are literals which are replaced
#! by computed values in the solve-recursion step.
node-out-d ;
! branching
UNION: #branch #ifte #dispatch ;
2005-09-17 04:15:05 -04:00
M: #branch returns* ( node -- ) node-children [ returns* ] each ;
M: #branch live-values* ( node -- )
#! This assumes that the last element of each branch is a
#! #return node.
2005-09-17 04:15:05 -04:00
dup delegate live-values* >r returns [ node-in-d ] map
unify-lengths purge-invariants r> append ;