basis/tools/crossref/crossref.factor

   1 ! Copyright (C) 2005, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators.short-circuit
   4 combinators.smart compiler.units generic generic.single
   5 hash-sets.identity hashtables help help.crossref help.markup
   6 help.topics init io io.pathnames io.styles kernel namespaces
   7 quotations see sequences sets sorting source-files threads
   8 vocabs words ;
   9 IN: tools.crossref
  10
  11 SYMBOL: crossref
  12
  13 GENERIC: uses ( defspec -- seq )
  14
  15 <PRIVATE
  16
  17 SYMBOL: visited
  18
  19 GENERIC#: quot-uses 1 ( obj set -- )
  20
  21 M: object quot-uses 2drop ;
  22
  23 M: word quot-uses over crossref? [ adjoin ] [ 2drop ] if ;
  24
  25 : seq-uses ( seq set -- )
  26     over visited get ?adjoin [
  27         [ quot-uses ] curry each
  28     ] [ 2drop ] if ; inline
  29
  30 : assoc-uses ( assoc' set -- )
  31     over visited get ?adjoin [
  32         [ quot-uses ] curry [ bi@ ] curry assoc-each
  33     ] [ 2drop ] if ; inline
  34
  35 M: array quot-uses seq-uses ;
  36
  37 M: hashtable quot-uses assoc-uses ;
  38
  39 M: callable quot-uses seq-uses ;
  40
  41 M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
  42
  43 M: callable uses
  44     IHS{ } clone visited [
  45         HS{ } clone [ quot-uses ] keep members
  46     ] with-variable ;
  47
  48 M: word uses def>> uses ;
  49
  50 M: link uses
  51     [ { $subsection $subsections $link $see-also } article-links [ >link ] map ]
  52     [ { $vocab-link } article-links [ >vocab-link ] map ]
  53     bi append ;
  54
  55 M: pathname uses
  56     string>> path>source-file top-level-form>> [ uses ] [ { } ] if* ;
  57
  58 ! To make UI browser happy
  59 M: object uses drop f ;
  60
  61 : crossref-def ( defspec -- )
  62     dup uses [ crossref get-global adjoin-at ] with each ;
  63
  64 : defs-to-crossref ( -- seq )
  65     [
  66         all-words
  67         [ [ generic? ] reject ]
  68         [ [ subwords ] map concat ] bi
  69
  70         all-articles [ >link ] map
  71
  72         source-files get keys [ <pathname> ] map
  73     ] append-outputs ;
  74
  75 : build-crossref ( -- crossref )
  76     "Computing usage index... " write flush yield
  77     H{ } clone [
  78         crossref set-global
  79         defs-to-crossref [ crossref-def ] each
  80     ] keep
  81     "done" print flush ;
  82
  83 : get-crossref ( -- crossref )
  84     crossref get-global [ build-crossref ] unless* ;
  85
  86 GENERIC: irrelevant? ( defspec -- ? )
  87
  88 M: object irrelevant? drop f ;
  89
  90 M: default-method irrelevant? drop t ;
  91
  92 M: predicate-engine-word irrelevant? drop t ;
  93
  94 PRIVATE>
  95
  96 : usage ( defspec -- seq ) get-crossref at members ;
  97
  98 GENERIC: smart-usage ( defspec -- seq )
  99
 100 M: object smart-usage usage [ irrelevant? ] reject ;
 101
 102 M: method smart-usage "method-generic" word-prop smart-usage ;
 103
 104 M: f smart-usage drop \ f smart-usage ;
 105
 106 : synopsis-alist ( definitions -- alist )
 107     [ [ synopsis ] keep ] { } map>assoc ;
 108
 109 : definitions. ( alist -- )
 110     [ write-object nl ] assoc-each ;
 111
 112 : sorted-definitions. ( definitions -- )
 113     synopsis-alist sort-keys definitions. ;
 114
 115 : usage. ( word -- )
 116     smart-usage
 117     [ "No usages." print ] [ sorted-definitions. ] if-empty ;
 118
 119 : vocab-xref ( vocab quot: ( defspec -- seq ) -- vocabs )
 120     [ [ vocab-name ] [ vocab-words [ generic? ] reject ] bi ] dip map
 121     [
 122         [ { [ word? ] [ generic? not ] } 1&& ] filter [
 123             dup method?
 124             [ "method-generic" word-prop ] when
 125             vocabulary>>
 126         ] map
 127     ] gather sort remove sift ; inline
 128
 129 : vocabs. ( seq -- )
 130     [ dup >vocab-link write-object nl ] each ;
 131
 132 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
 133
 134 : vocab-uses. ( vocab -- ) vocab-uses vocabs. ;
 135
 136 : vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
 137
 138 : vocab-usage. ( vocab -- ) vocab-usage vocabs. ;
 139
 140 <PRIVATE
 141
 142 SINGLETON: invalidate-crossref
 143
 144 M: invalidate-crossref definitions-changed
 145     ! reset crossref on non-empty definitions or f which
 146     ! indicates a source-file was parsed, cache otherwise
 147     drop [ null? not ] [ not ] bi or
 148     [ f crossref set-global ] when ;
 149
 150 STARTUP-HOOK: [ invalidate-crossref add-definition-observer ]
 151
 152 PRIVATE>