compiler.tree.propagation: fix scalability issue with constraints
							parent
							
								
									5615671560
								
							
						
					
					
						commit
						bd4e920995
					
				| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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*
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue