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
|
2005-09-16 02:39:33 -04:00
|
|
|
USING: arrays generic hashtables inference kernel
|
|
|
|
namespaces sequences ;
|
|
|
|
|
|
|
|
: node-union ( node quot -- hash | quot: node -- seq )
|
|
|
|
#! Build a hash with equal keys/values, effectively taking
|
|
|
|
#! the set union over all return values of the quotation.
|
|
|
|
[
|
|
|
|
swap [ swap call [ dup set ] each ] each-node-with
|
|
|
|
] make-hash ; inline
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-07 17:21:11 -04:00
|
|
|
GENERIC: literals* ( node -- seq )
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
: literals ( node -- hash )
|
|
|
|
[ literals* ] node-union ;
|
|
|
|
|
|
|
|
GENERIC: live-values* ( node -- seq )
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-16 02:39:33 -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
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
GENERIC: returns*
|
|
|
|
|
|
|
|
: returns ( node -- hash )
|
|
|
|
#! Trace all control flow paths, build a hash of
|
|
|
|
#! final #return nodes.
|
|
|
|
[ returns* ] node-union ;
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
: kill-set ( node -- seq )
|
2005-08-07 00:00:57 -04:00
|
|
|
#! Push a list of literals that may be killed in the IR.
|
2005-09-16 02:39:33 -04:00
|
|
|
dup live-values swap literals hash-diff hash-keys ;
|
2005-08-07 00:00:57 -04:00
|
|
|
|
|
|
|
: remove-values ( values node -- )
|
2005-09-16 02:39:33 -04:00
|
|
|
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 ( literals node -- )
|
2005-09-07 17:21:11 -04:00
|
|
|
[ remove-values ] each-node-with ;
|
2005-08-07 00:00:57 -04:00
|
|
|
|
|
|
|
! Generic nodes
|
2005-09-16 02:39:33 -04:00
|
|
|
M: node literals* ( node -- seq ) drop @{ }@ ;
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
M: node live-values* ( node -- seq ) node-values ;
|
|
|
|
|
|
|
|
M: node returns* ( node -- seq ) drop @{ }@ ;
|
2005-08-07 00:00:57 -04:00
|
|
|
|
2005-09-04 17:07:59 -04:00
|
|
|
! #shuffle
|
2005-09-16 02:39:33 -04:00
|
|
|
M: #shuffle literals* ( node -- seq )
|
2005-09-07 22:50:08 -04:00
|
|
|
node-out-d [ literal? ] subset ;
|
|
|
|
|
2005-09-07 17:21:11 -04:00
|
|
|
! #return
|
2005-09-16 02:39:33 -04:00
|
|
|
M: #return returns* 1array ;
|
2005-09-07 18:38:16 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
M: #return live-values* ( node -- seq )
|
|
|
|
#! Values returned by local labels can be killed.
|
|
|
|
dup node-param [ drop @{ }@ ] [ delegate live-values* ] ifte ;
|
2005-09-07 18:38:16 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
! nodes that don't use their input values directly
|
|
|
|
UNION: #killable #shuffle #call-label #merge #entry #values ;
|
2005-09-07 18:38:16 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
M: #killable live-values* ( node -- seq ) drop @{ }@ ;
|
2005-09-07 18:38:16 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
! branching
|
|
|
|
UNION: #branch #ifte #dispatch ;
|
2005-09-07 18:38:16 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
M: #branch live-values* ( node -- seq )
|
|
|
|
#! This assumes that the last element of each branch is a
|
|
|
|
#! #return node.
|
|
|
|
returns hash-keys [ node-in-d ] map unify-lengths flip
|
|
|
|
[ [ eq? ] monotonic? not ] subset concat ;
|