basis/tools/crossref/crossref.factor

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