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 ;
11 GENERIC: uses ( defspec -- seq )
17 GENERIC# quot-uses 1 ( obj assoc -- )
19 M: object quot-uses 2drop ;
21 M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ;
23 : (seq-uses) ( seq assoc -- )
24 [ quot-uses ] curry each ;
26 : seq-uses ( seq assoc -- )
27 over visited get memq? [ 2drop ] [
32 : assoc-uses ( assoc' assoc -- )
33 over visited get memq? [ 2drop ] [
35 [ >alist ] dip (seq-uses)
38 M: array quot-uses seq-uses ;
40 M: hashtable quot-uses assoc-uses ;
42 M: callable quot-uses seq-uses ;
44 M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
46 M: callable uses ( quot -- assoc )
48 H{ } clone [ quot-uses ] keep keys
51 M: word uses def>> uses ;
53 M: link uses { $subsection $link $see-also } article-links ;
55 M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
57 GENERIC: crossref-def ( defspec -- )
59 M: object crossref-def
60 dup uses crossref get add-vertex ;
63 [ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
65 : build-crossref ( -- crossref )
66 "Computing usage index... " write flush yield
69 source-files get keys [ <pathname> ] map
70 [ [ crossref-def ] each ] bi@
75 : get-crossref ( -- crossref )
76 crossref global [ drop build-crossref ] cache ;
78 GENERIC: irrelevant? ( defspec -- ? )
80 M: object irrelevant? drop f ;
82 M: default-method irrelevant? drop t ;
84 M: predicate-engine irrelevant? drop t ;
88 : usage ( defspec -- seq ) get-crossref at keys ;
90 GENERIC: smart-usage ( defspec -- seq )
92 M: object smart-usage usage [ irrelevant? not ] filter ;
94 M: method-body smart-usage "method-generic" word-prop smart-usage ;
96 M: f smart-usage drop \ f smart-usage ;
98 : synopsis-alist ( definitions -- alist )
99 [ [ synopsis ] keep ] { } map>assoc ;
101 : definitions. ( alist -- )
102 [ write-object nl ] assoc-each ;
104 : sorted-definitions. ( definitions -- )
105 synopsis-alist sort-keys definitions. ;
108 smart-usage sorted-definitions. ;
110 : vocab-xref ( vocab quot -- vocabs )
111 [ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
113 [ [ word? ] [ generic? not ] bi and ] filter [
115 [ "method-generic" word-prop ] when
118 ] gather natural-sort remove sift ; inline
121 [ dup >vocab-link write-object nl ] each ;
123 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
125 : vocab-uses. ( vocab -- ) vocab-uses vocabs. ;
127 : vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
129 : vocab-usage. ( vocab -- ) vocab-usage vocabs. ;
133 SINGLETON: invalidate-crossref
135 M: invalidate-crossref definitions-changed 2drop crossref global delete-at ;
137 [ invalidate-crossref add-definition-observer ] "tools.crossref" add-init-hook