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

[factor.git] / extra / lint / lint.factor

diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor
index 29fd5e9b3afb3d39bfdd29ec26fb5b39427c6ae4..2d33c0352026d90307fbd1dbea9087c65ab846b4 100644 (file)
--- a/extra/lint/lint.factor
+++ b/extra/lint/lint.factor
@@ -1,11 +1,12 @@
-! Copyright (C) 2007, 2008 Doug Coleman.
+! Copyright (C) 2007, 2008, 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: accessors alien arrays assocs classes
-classes.tuple.private combinators.short-circuit fry hashtables
-io kernel kernel.private locals.backend make math namespaces
-prettyprint quotations sequences sequences.deep shuffle
-slots.private vectors vocabs words words.alias ;
+classes.tuple.private combinators.short-circuit continuations
+fry hashtables io kernel kernel.private locals.backend make math
+math.private namespaces prettyprint quotations sequences
+sequences.deep shuffle slots.private splitting stack-checker
+vectors vocabs words words.alias ;
 
 IN: lint
 
@@ -18,7 +19,6 @@ CONSTANT: manual-substitutions
         { rot [ [ swap ] dip swap ] }
         { rot [ swapd swap ] }
         { over [ dup swap ] }
-        { tuck [ dup -rot ] }
         { swapd [ [ swap ] dip ] }
         { 2nip [ nip nip ] }
         { 2drop [ drop drop ] }
@@ -44,6 +44,9 @@ CONSTANT: trivial-defs
         [ compose compose ]
         [ empty? ] [ empty? not ]
         [ dup empty? ] [ dup empty? not ]
+        [ 2dup both-fixnums? ]
+        [ [ drop ] prepose ]
+        [ 1 0 ? ]
     }
 
 : lintable-word? ( word -- ? )
@@ -90,7 +93,7 @@ CONSTANT: trivial-defs
             {
                 [ length 2 = ]
                 [ first { [ sequence? ] [ assoc? ] } 1|| ]
-                [ second { clone clone-like like assoc-like make make-assoc } member? ]
+                [ second { clone clone-like like assoc-like make } member? ]
             } 1&&
         ]
 
@@ -183,13 +186,13 @@ CONSTANT: trivial-defs
             } 1&&
         ]
 
-        ! Remove [ { foo } declare class ]
+        ! Remove [ { foo } declare class-of ]
         [
             {
                 [ length 3 = ]
                 [ first { [ array? ] [ length 1 = ] } 1&& ]
                 [ second \ declare = ]
-                [ third \ class = ]
+                [ third \ class-of = ]
             } 1&&
         ]
 
@@ -229,7 +232,7 @@ SYMBOL: lint-definitions-keys
     lintable-words load-definitions
 
     ! Remove words that are their own definition
-    [ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map
+    [ [ [ def>> ] [ 1quotation ] bi = ] reject ] assoc-map
 
     ! Add manual definitions
     manual-substitutions over '[ _ push-at ] assoc-each
@@ -281,12 +284,32 @@ GENERIC: run-lint ( obj -- obj )
 
 M: sequence run-lint ( seq -- seq )
     [ dup lint ] { } map>assoc trim-self
-    [ second empty? not ] filter filter-symbols ;
+    [ second empty? ] reject filter-symbols ;
 
 M: word run-lint ( word -- seq ) 1array run-lint ;
 
 PRIVATE>
 
+: find-swap/swap ( word -- ? )
+    def>> [ callable? ] deep-filter
+    [
+        {
+            [ [ \ swap = ] count 2 >= ]
+            [
+                { swap } split rest but-last
+                [ [ infer ] [ 2drop ( -- ) ] recover ( x -- x ) = ] any?
+            ]
+        } 1&&
+    ] any? ;
+
+: find-redundant-word-props ( -- seq )
+    all-words [
+        {
+            [ { [ foldable? ] [ flushable? ] } 1|| ]
+            [ inline? ]
+        } 1&&
+    ] filter ;
+
 : lint-all ( -- seq )
     all-words run-lint dup lint. ;