115 lines
3.6 KiB
Factor
115 lines
3.6 KiB
Factor
! Copyright (C) 2009, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: assocs combinators 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 )
|
|
members [ word? ] filter [ +definition+ dependencies-of ] map ;
|
|
|
|
: outdated-effect-usages ( set -- assocs )
|
|
members [ word? ] filter [ 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 -- )
|
|
{
|
|
{ +effect+ "effect-dependencies" }
|
|
{ +conditional+ "conditional-dependencies" }
|
|
{ +definition+ "definition-dependencies" }
|
|
} [ store-dependencies-of-type ] 2with assoc-each ;
|
|
|
|
: add-xref ( word dependencies crossref -- )
|
|
rot '[
|
|
swap _ [ drop H{ } clone ] cache _ swap set-at
|
|
] assoc-each ;
|
|
|
|
: remove-xref ( word dependencies crossref -- )
|
|
[ keys ] dip '[ _ 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 ;
|
|
|
|
: set-at-each ( keys assoc value -- )
|
|
'[ _ [ _ ] 2dip set-at ] each ;
|
|
|
|
: join-dependencies ( effect-deps cond-deps def-deps -- assoc )
|
|
H{ } clone [
|
|
[ +effect+ set-at-each ]
|
|
[ +conditional+ set-at-each ]
|
|
[ +definition+ set-at-each ] tri-curry tri*
|
|
] keep ;
|
|
|
|
: load-dependencies ( word -- assoc )
|
|
[ "effect-dependencies" word-prop ]
|
|
[ "conditional-dependencies" word-prop ]
|
|
[ "definition-dependencies" word-prop ] tri
|
|
join-dependencies ;
|
|
|
|
: (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) ]
|
|
[ "effect-dependencies" remove-word-prop ]
|
|
[ "conditional-dependencies" remove-word-prop ]
|
|
[ "definition-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 ;
|