2010-07-28 00:49:26 -04:00
|
|
|
! Copyright (C) 2004, 2010 Slava Pestov.
|
2008-07-22 05:45:03 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-05-14 17:54:16 -04:00
|
|
|
USING: sequences accessors kernel assocs
|
2008-07-30 04:38:10 -04:00
|
|
|
compiler.tree
|
2008-08-07 07:34:28 -04:00
|
|
|
compiler.tree.propagation.copy
|
2008-07-22 05:45:03 -04:00
|
|
|
compiler.tree.propagation.info ;
|
|
|
|
IN: compiler.tree.propagation.nodes
|
|
|
|
|
2008-12-04 08:05:59 -05:00
|
|
|
SYMBOL: loop-nesting
|
|
|
|
|
2008-07-22 05:45:03 -04:00
|
|
|
GENERIC: propagate-before ( node -- )
|
|
|
|
|
|
|
|
GENERIC: propagate-after ( node -- )
|
|
|
|
|
2008-08-24 15:02:33 -04:00
|
|
|
GENERIC: annotate-node ( node -- )
|
|
|
|
|
2008-07-22 05:45:03 -04:00
|
|
|
GENERIC: propagate-around ( node -- )
|
|
|
|
|
2010-07-28 00:49:26 -04:00
|
|
|
: (propagate) ( nodes -- )
|
2008-08-07 02:08:11 -04:00
|
|
|
[ [ compute-copy-equiv ] [ propagate-around ] bi ] each ;
|
2008-07-30 04:38:10 -04:00
|
|
|
|
|
|
|
: extract-value-info ( values -- assoc )
|
|
|
|
[ dup value-info ] H{ } map>assoc ;
|
|
|
|
|
2008-08-24 15:02:33 -04:00
|
|
|
: (annotate-node) ( node values -- )
|
|
|
|
extract-value-info >>info drop ; inline
|
2008-07-30 04:38:10 -04:00
|
|
|
|
|
|
|
M: node propagate-before drop ;
|
|
|
|
|
|
|
|
M: node propagate-after drop ;
|
|
|
|
|
2008-08-24 15:02:33 -04:00
|
|
|
M: node annotate-node drop ;
|
|
|
|
|
2008-07-30 04:38:10 -04:00
|
|
|
M: node propagate-around
|
|
|
|
[ propagate-before ] [ annotate-node ] [ propagate-after ] tri ;
|