lint: fix using

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

diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor
index e6710302cce80e804d65b7a774d5853a9d27e501..b874bc8abbc483480c73f6c7c45adee5cb814bc5 100644 (file)
--- a/extra/lint/lint.factor
+++ b/extra/lint/lint.factor
@@ -1,13 +1,11 @@
-! 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 continuations
-fry hashtables io kernel kernel.private locals.backend make
-math namespaces prettyprint quotations sequences sequences.deep
-shuffle slots.private splitting stack-checker vectors vocabs
-words words.alias ;
-
+USING: accessors arrays assocs assocs.extras classes
+classes.tuple.private combinators.short-circuit continuations io
+kernel kernel.private locals.backend make math math.private
+namespaces prettyprint quotations sequences sequences.deep
+shuffle slots.private splitting stack-checker vocabs words
+words.alias ;
 IN: lint
 
 <PRIVATE
@@ -19,9 +17,11 @@ CONSTANT: manual-substitutions
         { rot [ [ swap ] dip swap ] }
         { rot [ swapd swap ] }
         { over [ dup swap ] }
-        { tuck [ dup -rot ] }
         { swapd [ [ swap ] dip ] }
+        { 2swap [ -roll -roll ] }
         { 2nip [ nip nip ] }
+        { 3nip [ 2nip nip ] }
+        { 4nip [ 3nip nip ] }
         { 2drop [ drop drop ] }
         { 3drop [ drop drop drop ] }
         { pop* [ pop drop ] }
@@ -33,7 +33,7 @@ CONSTANT: trivial-defs
     {
         [ ">" write ] [ "/>" write ] [ " " write ]
         [ 0 or + ]
-        [ dup length iota ]
+        [ dup length <iota> ]
         [ 0 swap copy ]
         [ dup length ]
         [ 0 swap ]
@@ -45,6 +45,9 @@ CONSTANT: trivial-defs
         [ compose compose ]
         [ empty? ] [ empty? not ]
         [ dup empty? ] [ dup empty? not ]
+        [ 2dup both-fixnums? ]
+        [ [ drop ] prepose ]
+        [ 1 0 ? ]
     }
 
 : lintable-word? ( word -- ? )
@@ -91,7 +94,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&&
         ]
 
@@ -145,7 +148,7 @@ CONSTANT: trivial-defs
         [
             {
                 [ length 4 <= ]
-                [ first { drop 2drop 3drop nip 2nip } member? ]
+                [ first { drop 2drop 3drop nip 2nip 3nip 4nip } member? ]
                 [ rest-slice [ boolean? ] all? ]
             } 1&&
         ]
@@ -184,13 +187,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&&
         ]
 
@@ -217,7 +220,7 @@ CONSTANT: trivial-defs
     [ { [ callable? ] [ ignore-def? not ] } 1&& ] deep-filter ;
 
 : (load-definitions) ( word def hash -- )
-    [ all-callables ] dip '[ _ push-at ] with each ;
+    [ all-callables ] dip push-at-each ;
 
 : load-definitions ( words -- hash )
     H{ } clone [ '[ dup def>> _ (load-definitions) ] each ] keep ;
@@ -230,7 +233,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
@@ -247,7 +250,7 @@ GENERIC: lint ( obj -- seq )
 M: object lint ( obj -- seq ) drop f ;
 
 M: callable lint ( quot -- seq )
-    [ lint-definitions-keys get-global ] dip '[ _ subseq? ] filter ;
+    lint-definitions-keys get-global [ subseq-index? ] with filter ;
 
 M: word lint ( word -- seq/f )
     def>> [ callable? ] deep-filter [ lint ] map concat ;
@@ -281,8 +284,8 @@ GENERIC: run-lint ( obj -- obj )
     ] assoc-filter ;
 
 M: sequence run-lint ( seq -- seq )
-    [ dup lint ] { } map>assoc trim-self
-    [ second empty? not ] filter filter-symbols ;
+    [ lint ] zip-with trim-self
+    [ second empty? ] reject filter-symbols ;
 
 M: word run-lint ( word -- seq ) 1array run-lint ;
 
@@ -300,14 +303,22 @@ PRIVATE>
         } 1&&
     ] any? ;
 
+: find-redundant-word-props ( -- seq )
+    all-words [
+        {
+            [ { [ foldable? ] [ flushable? ] } 1|| ]
+            [ inline? ]
+        } 1&&
+    ] filter ;
+
 : lint-all ( -- seq )
     all-words run-lint dup lint. ;
 
 : lint-vocab ( vocab -- seq )
-    words run-lint dup lint. ;
+    vocab-words run-lint dup lint. ;
 
 : lint-vocabs ( prefix -- seq )
-    [ vocabs ] dip [ head? ] curry filter [ lint-vocab ] map ;
+    [ loaded-vocab-names ] dip [ head? ] curry filter [ lint-vocab ] map ;
 
 : lint-word ( word -- seq )
     1array run-lint dup lint. ;