96 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			96 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Factor
		
	
	
| ! Copyright (C) 2009, 2010 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: assocs combinators compiler.units fry grouping kernel
 | |
| namespaces sequences sets stack-checker.dependencies words ;
 | |
| IN: compiler.crossref
 | |
| 
 | |
| SYMBOL: compiled-crossref
 | |
| 
 | |
| compiled-crossref [ H{ } clone ] initialize
 | |
| 
 | |
| SYMBOL: generic-call-site-crossref
 | |
| 
 | |
| generic-call-site-crossref [ H{ } clone ] initialize
 | |
| 
 | |
| : all-dependencies-of ( word -- assoc )
 | |
|     compiled-crossref get at ;
 | |
| 
 | |
| : dependencies-of ( word dep-type -- assoc )
 | |
|     [ all-dependencies-of ] dip '[ nip _ dependency>= ] assoc-filter ;
 | |
| 
 | |
| : outdated-definition-usages ( set -- assocs )
 | |
|     filter-word-defs [ +definition+ dependencies-of ] map ;
 | |
| 
 | |
| : outdated-effect-usages ( set -- assocs )
 | |
|     filter-word-defs [ all-dependencies-of ] map ;
 | |
| 
 | |
| : dependencies-satisfied? ( word cache -- ? )
 | |
|     [ "dependency-checks" word-prop ] dip
 | |
|     '[ _ [ satisfied? ] cache ] all? ;
 | |
| 
 | |
| : outdated-conditional-usages ( set -- assocs )
 | |
|     members H{ } clone '[
 | |
|         +conditional+ dependencies-of
 | |
|         [ drop _ dependencies-satisfied? ] assoc-reject
 | |
|     ] map ;
 | |
| 
 | |
| : generic-call-sites-of ( word -- assoc )
 | |
|     generic-call-site-crossref get at ;
 | |
| 
 | |
| : only-xref ( assoc -- assoc' )
 | |
|     [ drop crossref? ] { } assoc-filter-as ;
 | |
| 
 | |
| : set-generic-call-sites ( word alist -- )
 | |
|     concat f like "generic-call-sites" set-word-prop ;
 | |
| 
 | |
| : store-dependencies-of-type ( word assoc symbol prop-name -- )
 | |
|     [ rot '[ nip _ = ] assoc-filter keys ] dip set-word-prop ;
 | |
| 
 | |
| : store-dependencies ( word assoc -- )
 | |
|     keys "dependencies" set-word-prop ;
 | |
| 
 | |
| : add-xref ( word dependencies crossref -- )
 | |
|     rot '[
 | |
|         swap _ [ drop H{ } clone ] cache _ swap set-at
 | |
|     ] assoc-each ;
 | |
| 
 | |
| : remove-xref ( word dependencies crossref -- )
 | |
|     '[ _ at delete-at ] with each ;
 | |
| 
 | |
| : (compiled-xref) ( word dependencies generic-dependencies -- )
 | |
|     compiled-crossref generic-call-site-crossref
 | |
|     [ get add-xref ] bi-curry@ bi-curry* bi ;
 | |
| 
 | |
| : compiled-xref ( word dependencies generic-dependencies -- )
 | |
|     [ only-xref ] bi@
 | |
|     [ nip set-generic-call-sites ]
 | |
|     [ drop store-dependencies ]
 | |
|     [ (compiled-xref) ]
 | |
|     3tri ;
 | |
| 
 | |
| : load-dependencies ( word -- seq )
 | |
|     "dependencies" word-prop ;
 | |
| 
 | |
| : (compiled-unxref) ( word dependencies variable -- )
 | |
|     get remove-xref ;
 | |
| 
 | |
| : generic-call-sites ( word -- alist )
 | |
|     "generic-call-sites" word-prop 2 group ;
 | |
| 
 | |
| : compiled-unxref ( word -- )
 | |
|     {
 | |
|         [ dup load-dependencies compiled-crossref (compiled-unxref) ]
 | |
|         [ dup generic-call-sites generic-call-site-crossref (compiled-unxref) ]
 | |
|         [ "dependencies" remove-word-prop ]
 | |
|         [ "generic-call-sites" remove-word-prop ]
 | |
|     } cleave ;
 | |
| 
 | |
| : delete-compiled-xref ( word -- )
 | |
|     [ compiled-unxref ]
 | |
|     [ compiled-crossref get delete-at ]
 | |
|     [ generic-call-site-crossref get delete-at ]
 | |
|     tri ;
 | |
| 
 | |
| : set-dependency-checks ( word deps -- )
 | |
|     members f like "dependency-checks" set-word-prop ;
 |