50 lines
1.5 KiB
Factor
50 lines
1.5 KiB
Factor
! Copyright (C) 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: fry kernel sequences assocs accessors namespaces
|
|
math.intervals arrays classes.algebra
|
|
compiler.tree
|
|
compiler.tree.def-use
|
|
compiler.tree.propagation.info
|
|
compiler.tree.propagation.nodes
|
|
compiler.tree.propagation.simple
|
|
compiler.tree.propagation.constraints ;
|
|
IN: compiler.tree.propagation.branches
|
|
|
|
! For conditionals, an assoc of child node # --> constraint
|
|
GENERIC: child-constraints ( node -- seq )
|
|
|
|
M: #if child-constraints
|
|
in-d>> first
|
|
[ <true-constraint> ] [ <false-constraint> ] bi
|
|
2array ;
|
|
|
|
M: #dispatch child-constraints drop f ;
|
|
|
|
: infer-children ( node -- assocs )
|
|
[ children>> ] [ child-constraints ] bi [
|
|
[
|
|
value-infos [ clone ] change
|
|
constraints [ clone ] change
|
|
assume
|
|
(propagate)
|
|
] H{ } make-assoc
|
|
] 2map ;
|
|
|
|
: (merge-value-infos) ( inputs results -- infos )
|
|
'[ , [ [ value-info ] bind ] 2map value-infos-union ] map ;
|
|
|
|
: merge-value-infos ( results inputs outputs -- )
|
|
[ swap (merge-value-infos) ] dip set-value-infos ;
|
|
|
|
: propagate-branch-phi ( results #phi -- )
|
|
[ nip node-defs-values [ introduce-value ] each ]
|
|
[ [ phi-in-d>> ] [ out-d>> ] bi merge-value-infos ]
|
|
[ [ phi-in-r>> ] [ out-r>> ] bi merge-value-infos ]
|
|
2tri ;
|
|
|
|
: merge-children ( results node -- )
|
|
successor>> propagate-branch-phi ;
|
|
|
|
M: #branch propagate-around
|
|
[ infer-children ] [ merge-children ] [ annotate-node ] tri ;
|