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