basis/compiler/crossref/crossref.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: assocs combinators compiler.units grouping kernel
   4 namespaces sequences sets stack-checker.dependencies words ;
   5 IN: compiler.crossref
   6
   7 SYMBOL: compiled-crossref
   8
   9 compiled-crossref [ H{ } clone ] initialize
  10
  11 SYMBOL: generic-call-site-crossref
  12
  13 generic-call-site-crossref [ H{ } clone ] initialize
  14
  15 : all-dependencies-of ( word -- assoc )
  16     compiled-crossref get at ;
  17
  18 : dependencies-of ( word dep-type -- assoc )
  19     [ all-dependencies-of ] dip '[ nip _ dependency>= ] assoc-filter ;
  20
  21 : outdated-definition-usages ( set -- assocs )
  22     filter-word-defs [ +definition+ dependencies-of ] map ;
  23
  24 : outdated-effect-usages ( set -- assocs )
  25     filter-word-defs [ all-dependencies-of ] map ;
  26
  27 : dependencies-satisfied? ( word cache -- ? )
  28     [ "dependency-checks" word-prop ] dip
  29     '[ _ [ satisfied? ] cache ] all? ;
  30
  31 : outdated-conditional-usages ( set -- assocs )
  32     members H{ } clone '[
  33         +conditional+ dependencies-of
  34         [ drop _ dependencies-satisfied? ] assoc-reject
  35     ] map ;
  36
  37 : generic-call-sites-of ( word -- assoc )
  38     generic-call-site-crossref get at ;
  39
  40 : only-xref ( assoc -- assoc' )
  41     [ drop crossref? ] { } assoc-filter-as ;
  42
  43 : set-generic-call-sites ( word alist -- )
  44     concat f like "generic-call-sites" set-word-prop ;
  45
  46 : store-dependencies-of-type ( word assoc symbol prop-name -- )
  47     [ rot '[ nip _ = ] assoc-filter keys ] dip set-word-prop ;
  48
  49 : store-dependencies ( word assoc -- )
  50     keys "dependencies" set-word-prop ;
  51
  52 : add-xref ( word dependencies crossref -- )
  53     rot '[
  54         swap _ [ drop H{ } clone ] cache _ swap set-at
  55     ] assoc-each ;
  56
  57 : remove-xref ( word dependencies crossref -- )
  58     '[ _ at delete-at ] with each ;
  59
  60 : (compiled-xref) ( word dependencies generic-dependencies -- )
  61     compiled-crossref generic-call-site-crossref
  62     [ get add-xref ] bi-curry@ bi-curry* bi ;
  63
  64 : compiled-xref ( word dependencies generic-dependencies -- )
  65     [ only-xref ] bi@
  66     [ nip set-generic-call-sites ]
  67     [ drop store-dependencies ]
  68     [ (compiled-xref) ]
  69     3tri ;
  70
  71 : load-dependencies ( word -- seq )
  72     "dependencies" word-prop ;
  73
  74 : (compiled-unxref) ( word dependencies variable -- )
  75     get remove-xref ;
  76
  77 : generic-call-sites ( word -- alist )
  78     "generic-call-sites" word-prop 2 group ;
  79
  80 : compiled-unxref ( word -- )
  81     {
  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 ]
  86     } cleave ;
  87
  88 : delete-compiled-xref ( word -- )
  89     [ compiled-unxref ]
  90     [ compiled-crossref get delete-at ]
  91     [ generic-call-site-crossref get delete-at ]
  92     tri ;
  93
  94 : set-dependency-checks ( word deps -- )
  95     members f like "dependency-checks" set-word-prop ;