-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: words assocs definitions io io.pathnames io.styles kernel
-prettyprint sorting see sets sequences arrays hashtables help.crossref
-help.topics help.markup quotations accessors source-files namespaces
-graphs vocabs generic generic.standard.engines.tuple threads
-compiler.units init ;
+USING: accessors arrays assocs combinators.smart compiler.units
+generic generic.single graphs hash-sets.identity hashtables help
+help.crossref help.markup help.topics init io io.pathnames
+io.styles kernel namespaces quotations see sequences sets
+sorting source-files threads vocabs words ;
IN: tools.crossref
SYMBOL: crossref
SYMBOL: visited
-GENERIC# quot-uses 1 ( obj assoc -- )
+GENERIC# quot-uses 1 ( obj set -- )
M: object quot-uses 2drop ;
-M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ;
+M: word quot-uses over crossref? [ adjoin ] [ 2drop ] if ;
-: (seq-uses) ( seq assoc -- )
- [ quot-uses ] curry each ;
+: seq-uses ( seq set -- )
+ over visited get ?adjoin [
+ [ quot-uses ] curry each
+ ] [ 2drop ] if ; inline
-: seq-uses ( seq assoc -- )
- over visited get memq? [ 2drop ] [
- over visited get push
- (seq-uses)
- ] if ;
-
-: assoc-uses ( assoc' assoc -- )
- over visited get memq? [ 2drop ] [
- over visited get push
- [ >alist ] dip (seq-uses)
- ] if ;
+: assoc-uses ( assoc' set -- )
+ over visited get ?adjoin [
+ [ quot-uses ] curry [ bi@ ] curry assoc-each
+ ] [ 2drop ] if ; inline
M: array quot-uses seq-uses ;
M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
-M: callable uses ( quot -- assoc )
- V{ } clone visited [
- H{ } clone [ quot-uses ] keep keys
+M: callable uses ( quot -- seq )
+ IHS{ } clone visited [
+ HS{ } clone [ quot-uses ] keep members
] with-variable ;
M: word uses def>> uses ;
-M: link uses { $subsection $link $see-also } article-links ;
+M: link uses
+ [ { $subsection $subsections $link $see-also } article-links [ >link ] map ]
+ [ { $vocab-link } article-links [ >vocab-link ] map ]
+ bi append ;
M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
-GENERIC: crossref-def ( defspec -- )
+! To make UI browser happy
+M: object uses drop f ;
-M: object crossref-def
- dup uses crossref get add-vertex ;
+: crossref-def ( defspec -- )
+ dup uses crossref get-global add-vertex ;
-M: word crossref-def
- [ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
+: defs-to-crossref ( -- seq )
+ [
+ all-words
+ [ [ generic? ] reject ]
+ [ [ subwords ] map concat ] bi
+
+ all-articles [ >link ] map
+
+ source-files get keys [ <pathname> ] map
+ ] append-outputs ;
: build-crossref ( -- crossref )
"Computing usage index... " write flush yield
- H{ } clone crossref [
- all-words
- source-files get keys [ <pathname> ] map
- [ [ crossref-def ] each ] bi@
- crossref get
- ] with-variable
+ H{ } clone [
+ crossref set-global
+ defs-to-crossref [ crossref-def ] each
+ ] keep
"done" print flush ;
: get-crossref ( -- crossref )
- crossref global [ drop build-crossref ] cache ;
+ crossref get-global [ build-crossref ] unless* ;
GENERIC: irrelevant? ( defspec -- ? )
M: default-method irrelevant? drop t ;
-M: engine-word irrelevant? drop t ;
+M: predicate-engine-word irrelevant? drop t ;
PRIVATE>
GENERIC: smart-usage ( defspec -- seq )
-M: object smart-usage usage [ irrelevant? not ] filter ;
+M: object smart-usage usage [ irrelevant? ] reject ;
-M: method-body smart-usage "method-generic" word-prop smart-usage ;
+M: method smart-usage "method-generic" word-prop smart-usage ;
M: f smart-usage drop \ f smart-usage ;
synopsis-alist sort-keys definitions. ;
: usage. ( word -- )
- smart-usage sorted-definitions. ;
+ smart-usage
+ [ "No usages." print ] [ sorted-definitions. ] if-empty ;
-: vocab-xref ( vocab quot -- vocabs )
- [ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
+: vocab-xref ( vocab quot: ( defspec -- seq ) -- vocabs )
+ [ [ vocab-name ] [ words [ generic? ] reject ] bi ] dip map
[
[ [ word? ] [ generic? not ] bi and ] filter [
- dup method-body?
+ dup method?
[ "method-generic" word-prop ] when
vocabulary>>
] map
M: invalidate-crossref definitions-changed 2drop crossref global delete-at ;
-[ invalidate-crossref add-definition-observer ] "tools.crossref" add-init-hook
+[ invalidate-crossref add-definition-observer ] "tools.crossref" add-startup-hook
-PRIVATE>
\ No newline at end of file
+PRIVATE>