basis/tools/crossref/crossref.factor

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