2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: arrays namespaces assocs sequences kernel generic assocs
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-10 00:00:27 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								classes vectors accessors combinators sets
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								stack-checker.state
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								stack-checker.branches
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								compiler.tree
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								compiler.tree.combinators ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: compiler.tree.def-use
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: def-use
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: definition value node uses ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <definition> ( node value -- definition )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    definition new
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>value
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>node
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        V{ } clone >>uses ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: def-of ( value -- definition )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    def-use get at* [ "No def" throw ] unless ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: def-value ( node value -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    def-use get 2dup key? [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "Multiple defs" throw
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ [ <definition> ] keep ] dip set-at
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: used-by ( value -- nodes ) def-of uses>> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: use-value ( node value -- ) used-by push ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: defined-by ( value -- node ) def-of node>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								GENERIC: node-uses-values ( node -- values )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #introduce node-uses-values drop f ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #push node-uses-values drop f ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #r> node-uses-values in-r>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-18 21:49:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #declare node-uses-values declaration>> keys ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-15 00:35:19 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #alien-callback node-uses-values drop f ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: node node-uses-values in-d>> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								GENERIC: node-defs-values ( node -- values )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #>r node-defs-values out-r>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-27 21:25:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #branch node-defs-values drop f ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #declare node-defs-values drop f ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #return node-defs-values drop f ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #recursive node-defs-values drop f ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: #terminate node-defs-values drop f ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-15 00:35:19 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: #alien-callback node-defs-values drop f ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: node node-defs-values out-d>> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: node-def-use ( node -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-22 05:45:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ dup node-uses-values [ use-value ] with each ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ dup node-defs-values [ def-value ] with each ] bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: compute-def-use ( node -- node )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    H{ } clone def-use set
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-10 00:00:27 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup [ node-def-use ] each-node ;
							 |