-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: fry kernel sequences assocs accessors namespaces
+USING: fry kernel sequences assocs accessors
math.intervals arrays classes.algebra combinators columns
-stack-checker.branches locals math
+stack-checker.branches locals math namespaces
compiler.utilities
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.nodes
compiler.tree.propagation.simple
compiler.tree.propagation.constraints ;
+FROM: sets => union ;
+FROM: assocs => change-at ;
IN: compiler.tree.propagation.branches
! For conditionals, an assoc of child node # --> constraint
bi ;
:: update-constraints ( new old -- )
- new [| key value | key old [ value append ] change-at ] assoc-each ;
+ new [| key value | key old [ value union ] change-at ] assoc-each ;
: include-child-constraints ( i -- )
infer-children-data get nth constraints swap at last
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs math math.intervals kernel accessors
sequences namespaces classes classes.algebra
C: --> implication
+: maybe-add ( elt seq -- seq' )
+ 2dup member? [ nip ] [ swap suffix ] if ;
+
: assume-implication ( q p -- )
- [ constraints get [ assoc-stack swap suffix ] 2keep last set-at ]
+ [ constraints get [ assoc-stack maybe-add ] 2keep last set-at ]
[ satisfied? [ assume ] [ drop ] if ] 2bi ;
M: implication assume*