1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: assocs combinators compiler.units grouping kernel
4 namespaces sequences sets stack-checker.dependencies words ;
7 SYMBOL: compiled-crossref
9 compiled-crossref [ H{ } clone ] initialize
11 SYMBOL: generic-call-site-crossref
13 generic-call-site-crossref [ H{ } clone ] initialize
15 : all-dependencies-of ( word -- assoc )
16 compiled-crossref get at ;
18 : dependencies-of ( word dep-type -- assoc )
19 [ all-dependencies-of ] dip '[ nip _ dependency>= ] assoc-filter ;
21 : outdated-definition-usages ( set -- assocs )
22 filter-word-defs [ +definition+ dependencies-of ] map ;
24 : outdated-effect-usages ( set -- assocs )
25 filter-word-defs [ all-dependencies-of ] map ;
27 : dependencies-satisfied? ( word cache -- ? )
28 [ "dependency-checks" word-prop ] dip
29 '[ _ [ satisfied? ] cache ] all? ;
31 : outdated-conditional-usages ( set -- assocs )
33 +conditional+ dependencies-of
34 [ drop _ dependencies-satisfied? ] assoc-reject
37 : generic-call-sites-of ( word -- assoc )
38 generic-call-site-crossref get at ;
40 : only-xref ( assoc -- assoc' )
41 [ drop crossref? ] { } assoc-filter-as ;
43 : set-generic-call-sites ( word alist -- )
44 concat f like "generic-call-sites" set-word-prop ;
46 : store-dependencies-of-type ( word assoc symbol prop-name -- )
47 [ rot '[ nip _ = ] assoc-filter keys ] dip set-word-prop ;
49 : store-dependencies ( word assoc -- )
50 keys "dependencies" set-word-prop ;
52 : add-xref ( word dependencies crossref -- )
54 swap _ [ drop H{ } clone ] cache _ swap set-at
57 : remove-xref ( word dependencies crossref -- )
58 '[ _ at delete-at ] with each ;
60 : (compiled-xref) ( word dependencies generic-dependencies -- )
61 compiled-crossref generic-call-site-crossref
62 [ get add-xref ] bi-curry@ bi-curry* bi ;
64 : compiled-xref ( word dependencies generic-dependencies -- )
66 [ nip set-generic-call-sites ]
67 [ drop store-dependencies ]
71 : load-dependencies ( word -- seq )
72 "dependencies" word-prop ;
74 : (compiled-unxref) ( word dependencies variable -- )
77 : generic-call-sites ( word -- alist )
78 "generic-call-sites" word-prop 2 group ;
80 : compiled-unxref ( word -- )
82 [ dup load-dependencies compiled-crossref (compiled-unxref) ]
83 [ dup generic-call-sites generic-call-site-crossref (compiled-unxref) ]
84 [ "dependencies" remove-word-prop ]
85 [ "generic-call-sites" remove-word-prop ]
88 : delete-compiled-xref ( word -- )
90 [ compiled-crossref get delete-at ]
91 [ generic-call-site-crossref get delete-at ]
94 : set-dependency-checks ( word deps -- )
95 members f like "dependency-checks" set-word-prop ;