compiler.tree.propagation: fix scalability issue with constraints

release
Slava Pestov 2010-04-14 17:19:26 -07:00
parent 5615671560
commit bd4e920995
2 changed files with 11 additions and 6 deletions

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 math.intervals arrays classes.algebra combinators columns
stack-checker.branches locals math stack-checker.branches locals math namespaces
compiler.utilities compiler.utilities
compiler.tree compiler.tree
compiler.tree.combinators compiler.tree.combinators
@ -10,6 +10,8 @@ compiler.tree.propagation.info
compiler.tree.propagation.nodes compiler.tree.propagation.nodes
compiler.tree.propagation.simple compiler.tree.propagation.simple
compiler.tree.propagation.constraints ; compiler.tree.propagation.constraints ;
FROM: sets => union ;
FROM: assocs => change-at ;
IN: compiler.tree.propagation.branches IN: compiler.tree.propagation.branches
! For conditionals, an assoc of child node # --> constraint ! For conditionals, an assoc of child node # --> constraint
@ -90,7 +92,7 @@ M: #phi propagate-before ( #phi -- )
bi ; bi ;
:: update-constraints ( new old -- ) :: 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 -- ) : include-child-constraints ( i -- )
infer-children-data get nth constraints swap at last infer-children-data get nth constraints swap at last

View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs math math.intervals kernel accessors USING: arrays assocs math math.intervals kernel accessors
sequences namespaces classes classes.algebra sequences namespaces classes classes.algebra
@ -87,8 +87,11 @@ TUPLE: implication p q ;
C: --> implication C: --> implication
: maybe-add ( elt seq -- seq' )
2dup member? [ nip ] [ swap suffix ] if ;
: assume-implication ( q p -- ) : 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 ; [ satisfied? [ assume ] [ drop ] if ] 2bi ;
M: implication assume* M: implication assume*