basis/tools/crossref/crossref.factor

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