| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | USING: sequences kernel fry vectors | 
					
						
							| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | compiler.tree compiler.tree.def-use ;
 | 
					
						
							|  |  |  | IN: compiler.tree.def-use.simplified | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Simplified def-use follows chains of copies. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! A 'real' usage is a usage of a value that is not a #renaming. | 
					
						
							|  |  |  | TUPLE: real-usage value node ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Def | 
					
						
							|  |  |  | GENERIC: actually-defined-by* ( value node -- real-usage )
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : actually-defined-by ( value -- real-usage )
 | 
					
						
							|  |  |  |     dup defined-by actually-defined-by* ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: #renaming actually-defined-by* | 
					
						
							|  |  |  |     inputs/outputs swap [ index ] dip nth actually-defined-by ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: #return-recursive actually-defined-by* real-usage boa ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: node actually-defined-by* real-usage boa ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Use | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | GENERIC# actually-used-by* 1 ( value node accum -- )
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (actually-used-by) ( value accum -- )
 | 
					
						
							|  |  |  |     [ [ used-by ] keep ] dip '[ _ swap _ actually-used-by* ] each ;
 | 
					
						
							| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: #renaming actually-used-by* | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  |     [ inputs/outputs [ indices ] dip nths ] dip
 | 
					
						
							|  |  |  |     '[ _ (actually-used-by) ] each ;
 | 
					
						
							| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | M: #return-recursive actually-used-by* [ real-usage boa ] dip push ;
 | 
					
						
							| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | M: node actually-used-by* [ real-usage boa ] dip push ;
 | 
					
						
							| 
									
										
										
										
											2008-09-12 19:08:38 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : actually-used-by ( value -- real-usages )
 | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  |     10 <vector> [ (actually-used-by) ] keep ;
 |