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

[factor.git] / basis / help / lint / lint.factor

diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
old mode 100755 (executable)
new mode 100644 (file)
index 1fb8364..2511590
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -1,10 +1,11 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs continuations fry help help.lint.checks
-help.topics io kernel namespaces parser sequences
-source-files.errors vocabs.hierarchy vocabs words classes
-locals tools.errors listener ;
+USING: assocs combinators continuations fry help
+help.lint.checks help.topics io kernel namespaces parser
+sequences source-files.errors vocabs.hierarchy vocabs words
+classes locals tools.errors listener ;
 FROM: help.lint.checks => all-vocabs ;
+FROM: vocabs => child-vocabs ;
 IN: help.lint
 
 SYMBOL: lint-failures
@@ -15,7 +16,7 @@ TUPLE: help-lint-error < source-file-error ;
 
 SYMBOL: +help-lint-failure+
 
-T{ error-type
+T{ error-type-holder
    { type +help-lint-failure+ }
    { word ":lint-failures" }
    { plural "help lint failures" }
@@ -33,7 +34,7 @@ M: help-lint-error error-type drop +help-lint-failure+ ;
 
 PRIVATE>
 
-: help-lint-error ( error topic -- )
+: notify-help-lint-error ( error topic -- )
     lint-failures get pick
     [ [ [ <help-lint-error> ] keep ] dip set-at ] [ delete-at drop ] if
     notify-error-observers ;
@@ -42,16 +43,18 @@ PRIVATE>
 
 :: check-something ( topic quot -- )
     [ quot call( -- ) f ] [ ] recover
-    topic help-lint-error ; inline
+    topic notify-help-lint-error ; inline
 
 : check-word ( word -- )
     [ with-file-vocabs ] vocabs-quot set
     dup word-help [
         [ >link ] keep '[
-            _ dup word-help
-            [ check-values ]
-            [ check-class-description ]
-            [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2tri
+            _ dup word-help {
+                [ check-values ]
+                [ check-value-effects ]
+                [ check-class-description ]
+                [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
+            } 2cleave
         ] check-something
     ] [ drop ] if ;
 
@@ -64,11 +67,11 @@ PRIVATE>
     ] check-something ;
 
 : check-about ( vocab -- )
-    vocab-link boa dup
-    '[ _ vocab-help [ article drop ] when* ] check-something ;
+    <vocab-link> dup
+    '[ _ vocab-help [ lookup-article drop ] when* ] check-something ;
 
 : check-vocab ( vocab -- )
-    "Checking " write dup write "..." print
+    "Checking " write dup write "..." print flush
     [ check-about ]
     [ words [ check-word ] each ]
     [ vocab-articles get at [ check-article ] each ]
@@ -79,7 +82,7 @@ PRIVATE>
 : help-lint ( prefix -- )
     [
         auto-use? off
-        all-vocabs-seq [ vocab-name ] map all-vocabs set
+        all-vocab-names all-vocabs set
         group-articles vocab-articles set
         child-vocabs
         [ check-vocab ] each
@@ -89,13 +92,11 @@ PRIVATE>
 
 : :lint-failures ( -- ) lint-failures get values errors. ;
 
-: unlinked-words ( words -- seq )
-    all-word-help [ article-parent not ] filter ;
+: unlinked-words ( vocab -- seq )
+    words all-word-help [ article-parent ] reject ;
 
 : linked-undocumented-words ( -- seq )
     all-words
-    [ word-help not ] filter
+    [ word-help ] reject
     [ article-parent ] filter
-    [ predicate? not ] filter ;
-
-MAIN: help-lint
+    [ predicate? ] reject ;