use reject instead of [ ... not ] filter.

[factor.git] / basis / tools / crossref / crossref.factor

diff --git a/basis/tools/crossref/crossref.factor b/basis/tools/crossref/crossref.factor
index daa30100a46e30c64913534b462380403a026359..04aae88ae8776043f896e97aafa347da4be18146 100644 (file)
--- a/basis/tools/crossref/crossref.factor
+++ b/basis/tools/crossref/crossref.factor
@@ -1,10 +1,10 @@
 ! 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
-help.crossref help.topics help.markup quotations accessors
-source-files namespaces graphs vocabs generic generic.single
-threads compiler.units init combinators.smart ;
+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
@@ -15,26 +15,21 @@ GENERIC: uses ( defspec -- seq )
 
 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 member-eq? [ 2drop ] [
-        over visited get push
-        (seq-uses)
-    ] if ;
-
-: assoc-uses ( assoc' assoc -- )
-    over visited get member-eq? [ 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 ;
 
@@ -44,9 +39,9 @@ M: callable 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 ;
@@ -59,20 +54,19 @@ M: link uses
 M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
 
 ! To make UI browser happy
-M: vocab uses drop f ;
-
-GENERIC: crossref-def ( defspec -- )
-
-M: object crossref-def
-    dup uses crossref get add-vertex ;
+M: object uses drop f ;
 
-M: word crossref-def
-    [ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
+: crossref-def ( defspec -- )
+    dup uses crossref get-global add-vertex ;
 
 : defs-to-crossref ( -- seq )
     [
         all-words
+        [ [ generic? ] reject ]
+        [ [ subwords ] map concat ] bi
+
         all-articles [ >link ] map
+
         source-files get keys [ <pathname> ] map
     ] append-outputs ;
 
@@ -93,7 +87,7 @@ M: object irrelevant? drop f ;
 
 M: default-method irrelevant? drop t ;
 
-M: predicate-engine irrelevant? drop t ;
+M: predicate-engine-word irrelevant? drop t ;
 
 PRIVATE>
 
@@ -101,9 +95,9 @@ 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 ;
 
@@ -120,11 +114,11 @@ M: f smart-usage drop \ f smart-usage ;
     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