2008-07-24 00:50:21 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-08-01 21:00:12 -04:00
|
|
|
USING: namespaces sequences assocs math kernel accessors fry
|
2009-01-16 16:14:30 -05:00
|
|
|
combinators sets locals columns grouping
|
2008-08-10 00:00:27 -04:00
|
|
|
stack-checker.branches
|
2008-08-01 21:00:12 -04:00
|
|
|
compiler.tree
|
|
|
|
compiler.tree.def-use
|
|
|
|
compiler.tree.combinators ;
|
2008-08-07 07:34:28 -04:00
|
|
|
IN: compiler.tree.propagation.copy
|
2008-08-07 02:08:11 -04:00
|
|
|
|
2008-07-30 04:38:10 -04:00
|
|
|
! Two values are copy-equivalent if they are always identical
|
2008-08-04 05:35:31 -04:00
|
|
|
! at run-time ("DS" relation). This is just a weak form of
|
|
|
|
! value numbering.
|
2008-07-30 04:38:10 -04:00
|
|
|
|
2008-08-01 21:00:12 -04:00
|
|
|
! Mapping from values to their canonical leader
|
2008-07-24 00:50:21 -04:00
|
|
|
SYMBOL: copies
|
|
|
|
|
2008-08-01 21:00:12 -04:00
|
|
|
:: compress-path ( source assoc -- destination )
|
|
|
|
[let | destination [ source assoc at ] |
|
|
|
|
source destination = [ source ] [
|
|
|
|
[let | destination' [ destination assoc compress-path ] |
|
|
|
|
destination' destination = [
|
|
|
|
destination' source assoc set-at
|
|
|
|
] unless
|
|
|
|
destination'
|
|
|
|
]
|
|
|
|
] if
|
|
|
|
] ;
|
2008-07-24 00:50:21 -04:00
|
|
|
|
2008-08-07 02:08:11 -04:00
|
|
|
: resolve-copy ( copy -- val ) copies get compress-path ;
|
2008-08-01 21:00:12 -04:00
|
|
|
|
|
|
|
: is-copy-of ( val copy -- ) copies get set-at ;
|
2008-07-24 00:50:21 -04:00
|
|
|
|
2008-08-01 21:00:12 -04:00
|
|
|
: are-copies-of ( vals copies -- ) [ is-copy-of ] 2each ;
|
2008-07-24 00:50:21 -04:00
|
|
|
|
2008-08-01 21:00:12 -04:00
|
|
|
: introduce-value ( val -- ) copies get conjoin ;
|
2008-07-24 00:50:21 -04:00
|
|
|
|
|
|
|
GENERIC: compute-copy-equiv* ( node -- )
|
|
|
|
|
2008-08-07 07:34:28 -04:00
|
|
|
M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
|
2008-07-27 03:32:40 -04:00
|
|
|
|
2008-07-28 07:31:26 -04:00
|
|
|
: compute-phi-equiv ( inputs outputs -- )
|
|
|
|
#! An output is a copy of every input if all inputs are
|
|
|
|
#! copies of the same original value.
|
|
|
|
[
|
2008-08-10 00:00:27 -04:00
|
|
|
swap remove-bottom [ resolve-copy ] map
|
2008-07-28 07:31:26 -04:00
|
|
|
dup [ all-equal? ] [ empty? not ] bi and
|
|
|
|
[ first swap is-copy-of ] [ 2drop ] if
|
|
|
|
] 2each ;
|
|
|
|
|
|
|
|
M: #phi compute-copy-equiv*
|
2008-12-06 12:17:19 -05:00
|
|
|
[ phi-in-d>> flip ] [ out-d>> ] bi compute-phi-equiv ;
|
2008-07-28 07:31:26 -04:00
|
|
|
|
2008-07-24 00:50:21 -04:00
|
|
|
M: node compute-copy-equiv* drop ;
|
|
|
|
|
2008-08-07 02:08:11 -04:00
|
|
|
: compute-copy-equiv ( node -- )
|
|
|
|
[ node-defs-values [ introduce-value ] each ]
|
|
|
|
[ compute-copy-equiv* ]
|
|
|
|
bi ;
|