1 ! Copyright (C) 2005, 2010 Slava Pestov.
2 ! See https://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 ;
12 GENERIC: uses ( defspec -- seq )
18 GENERIC#: quot-uses 1 ( obj set -- )
20 M: object quot-uses 2drop ;
22 M: word quot-uses over crossref? [ adjoin ] [ 2drop ] if ;
24 : seq-uses ( seq set -- )
25 over visited get ?adjoin [
26 [ quot-uses ] curry each
27 ] [ 2drop ] if ; inline
29 : assoc-uses ( assoc' set -- )
30 over visited get ?adjoin [
31 [ quot-uses ] curry [ bi@ ] curry assoc-each
32 ] [ 2drop ] if ; inline
34 M: array quot-uses seq-uses ;
36 M: hashtable quot-uses assoc-uses ;
38 M: callable quot-uses seq-uses ;
40 M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
43 IHS{ } clone visited [
44 HS{ } clone [ quot-uses ] keep members
47 M: word uses def>> uses ;
50 [ { $subsection $subsections $link $see-also } article-links [ >link ] map ]
51 [ { $vocab-link } article-links [ >vocab-link ] map ]
55 string>> path>source-file top-level-form>> [ uses ] [ { } ] if* ;
57 ! To make UI browser happy
58 M: object uses drop f ;
60 : crossref-def ( defspec -- )
61 dup uses [ crossref get-global adjoin-at ] with each ;
63 : defs-to-crossref ( -- seq )
66 [ [ generic? ] reject ]
67 [ [ subwords ] map concat ] bi
69 all-articles [ >link ] map
71 source-files get keys [ <pathname> ] map
74 : build-crossref ( -- crossref )
75 "Computing usage index... " write flush yield
78 defs-to-crossref [ crossref-def ] each
82 : get-crossref ( -- crossref )
83 crossref get-global [ build-crossref ] unless* ;
85 GENERIC: irrelevant? ( defspec -- ? )
87 M: object irrelevant? drop f ;
89 M: default-method irrelevant? drop t ;
91 M: predicate-engine-word irrelevant? drop t ;
95 : usage ( defspec -- seq ) get-crossref at members ;
97 GENERIC: smart-usage ( defspec -- seq )
99 M: object smart-usage usage [ irrelevant? ] reject ;
101 M: method smart-usage "method-generic" word-prop smart-usage ;
103 M: f smart-usage drop \ f smart-usage ;
105 : synopsis-alist ( definitions -- alist )
106 [ [ synopsis ] keep ] { } map>assoc ;
108 : definitions. ( alist -- )
109 [ write-object nl ] assoc-each ;
111 : sorted-definitions. ( definitions -- )
112 synopsis-alist sort-keys definitions. ;
116 [ "No usages." print ] [ sorted-definitions. ] if-empty ;
118 : vocab-xref ( vocab quot: ( defspec -- seq ) -- vocabs )
119 [ [ vocab-name ] [ vocab-words [ generic? ] reject ] bi ] dip map
121 [ [ word? ] [ generic? not ] bi and ] filter [
123 [ "method-generic" word-prop ] when
126 ] gather natural-sort remove sift ; inline
129 [ dup >vocab-link write-object nl ] each ;
131 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
133 : vocab-uses. ( vocab -- ) vocab-uses vocabs. ;
135 : vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
137 : vocab-usage. ( vocab -- ) vocab-usage vocabs. ;
141 SINGLETON: invalidate-crossref
143 M: invalidate-crossref definitions-changed
144 ! reset crossref on non-empty definitions or f which
145 ! indicates a source-file was parsed, cache otherwise
146 drop [ null? not ] [ not ] bi or
147 [ f crossref set-global ] when ;
149 STARTUP-HOOK: [ invalidate-crossref add-definition-observer ]