| 
									
										
										
										
											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 ;
 |