| 
									
										
										
										
											2008-08-02 00:31:43 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-08-14 00:52:49 -04:00
										 |  |  | USING: accessors kernel namespaces sequences sets fry columns | 
					
						
							| 
									
										
										
										
											2009-01-16 16:14:30 -05:00
										 |  |  | grouping stack-checker.branches | 
					
						
							| 
									
										
										
										
											2008-08-02 00:31:43 -04:00
										 |  |  | compiler.tree | 
					
						
							|  |  |  | compiler.tree.propagation.branches | 
					
						
							|  |  |  | compiler.tree.escape-analysis.nodes | 
					
						
							|  |  |  | compiler.tree.escape-analysis.allocations ;
 | 
					
						
							|  |  |  | IN: compiler.tree.escape-analysis.branches | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: #branch escape-analysis* | 
					
						
							| 
									
										
										
										
											2008-08-10 00:00:27 -04:00
										 |  |  |     [ in-d>> add-escaping-values ] | 
					
						
							|  |  |  |     [ live-children sift [ (escape-analysis) ] each ] | 
					
						
							|  |  |  |     bi ;
 | 
					
						
							| 
									
										
										
										
											2008-08-02 00:31:43 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : (merge-allocations) ( values -- allocation )
 | 
					
						
							|  |  |  |     [ | 
					
						
							| 
									
										
										
										
											2008-09-06 20:13:59 -04:00
										 |  |  |         dup [ allocation ] map sift [ drop f ] [ | 
					
						
							| 
									
										
										
										
											2008-08-04 05:35:31 -04:00
										 |  |  |             dup [ t eq? not ] all? [ | 
					
						
							|  |  |  |                 dup [ length ] map all-equal? [ | 
					
						
							|  |  |  |                     nip flip
 | 
					
						
							|  |  |  |                     [ (merge-allocations) ] [ [ merge-slots ] map ] bi
 | 
					
						
							|  |  |  |                     [ record-allocations ] keep
 | 
					
						
							|  |  |  |                 ] [ drop add-escaping-values t ] if
 | 
					
						
							|  |  |  |             ] [ drop add-escaping-values t ] if
 | 
					
						
							| 
									
										
										
										
											2008-09-06 20:13:59 -04:00
										 |  |  |         ] if-empty
 | 
					
						
							| 
									
										
										
										
											2008-08-02 00:31:43 -04:00
										 |  |  |     ] map ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : merge-allocations ( in-values out-values -- )
 | 
					
						
							| 
									
										
										
										
											2008-08-10 00:00:27 -04:00
										 |  |  |     [ [ remove-bottom ] map ] dip
 | 
					
						
							| 
									
										
										
										
											2008-08-03 22:32:12 -04:00
										 |  |  |     [ [ merge-values ] 2each ] | 
					
						
							|  |  |  |     [ [ (merge-allocations) ] dip record-allocations ] | 
					
						
							|  |  |  |     2bi ;
 | 
					
						
							| 
									
										
										
										
											2008-08-02 00:31:43 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: #phi escape-analysis* | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  |     [ phi-in-d>> flip ] [ out-d>> ] bi merge-allocations ;
 |