Cleanup lint warnings.

basis/alien/parser/parser.factor

@@ -88,7 +88,7 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
     [ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ;
 
 : parse-enum-name ( -- name )
-    scan-token (CREATE-C-TYPE) dup save-location ;
+    CREATE-C-TYPE dup save-location ;
 
 : parse-enum-base-type ( -- base-type token )
     scan-token dup "<" =

basis/classes/struct/bit-accessors/bit-accessors.factor

@@ -1,13 +1,14 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences math fry locals math.order alien.accessors ;
+USING: alien.accessors fry kernel locals math math.bitwise
+math.order sequences ;
 IN: classes.struct.bit-accessors
 
 ! Bitfield accessors are little-endian on all platforms
 ! Why not? It's unspecified in C
 
 : ones-between ( start end -- n )
-    [ 2^ 1 - ] bi@ swap bitnot bitand ;
+    [ on-bits ] bi@ swap unmask ;
 
 :: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' )
     offset 8 /mod :> ( i start-bit )

basis/compiler/cfg/liveness/liveness.factor

@@ -122,7 +122,7 @@ M: insn visit-insn drop ;
 SYMBOL: work-list
 
 : add-to-work-list ( basic-blocks -- )
-    work-list get '[ _ push-front ] each ;
+    work-list get push-all-front ;
 
 : compute-live-in ( basic-block -- live-in )
     [ live-out ] keep instructions>> transfer-liveness ;

basis/compiler/cfg/representations/selection/selection.factor

@@ -57,7 +57,7 @@ SYMBOL: possibilities
 : possible-reps ( vreg reps -- vreg reps )
     { tagged-rep } union
     2dup [ tagged-vregs get in? not ] [ { tagged-rep } = ] bi* and
-    [ drop { tagged-rep int-rep } ] [ ] if ;
+    [ drop { tagged-rep int-rep } ] when ;
 
 : compute-possibilities ( cfg -- )
     collect-vreg-reps

basis/compiler/cfg/stacks/uninitialized/uninitialized.factor

@@ -68,7 +68,7 @@ M: insn visit-insn drop ;
 : finish ( -- pair ) ds-loc get rs-loc get 2array ;
 
 : (join-sets) ( seq1 seq2 -- seq )
-    2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
+    2dup max-length '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
 
 PRIVATE>
 

basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor

@@ -109,7 +109,7 @@ M: node compute-modular-candidates*
 GENERIC: only-reads-low-order? ( node -- ? )
 
 : output-modular? ( #call -- ? )
-    out-d>> first modular-values get key? ;
+    out-d>> first modular-value? ;
 
 M: #call only-reads-low-order?
     {

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -105,7 +105,7 @@ SYMBOL: history
     "custom-inlining" word-prop ;
 
 : inline-custom ( #call word -- ? )
-    [ dup ] [ "custom-inlining" word-prop ] bi*
+    [ dup ] [ custom-inlining? ] bi*
     call( #call -- word/quot/f )
     object swap eliminate-dispatch ;
 

basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor

@@ -169,5 +169,5 @@ M: #alien-node unbox-tuples* dup in-d>> assert-not-unboxed ;
 M: #alien-callback unbox-tuples* ;
 
 : unbox-tuples ( nodes -- nodes )
-    allocations get escaping-allocations get assoc-diff assoc-empty?
+    (allocation) escaping-allocations get assoc-diff assoc-empty?
     [ [ unbox-tuples* ] map-nodes ] unless ;

basis/farkup/farkup.factor

@@ -104,7 +104,6 @@ DEFER: (parse-paragraph)
 
 : <farkup-state> ( string -- state ) string-lines ;
 : look ( state i -- char ) swap first ?nth ;
-: done? ( state -- ? ) empty? ;
 : take-line ( state -- state' line ) unclip-slice ;
 
 : take-lines ( state char -- state' lines )
@@ -207,7 +206,7 @@ DEFER: (parse-paragraph)
     } case ;
 
 : parse-farkup ( string -- farkup )
-    <farkup-state> [ dup done? not ] [ parse-item ] produce nip sift ;
+    <farkup-state> [ dup empty? not ] [ parse-item ] produce nip sift ;
 
 CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
 

basis/furnace/asides/asides.factor

@@ -46,8 +46,7 @@ SYMBOL: aside-id
 
 : init-asides ( asides -- )
     asides set
-    request get request-aside-id
-    get-aside
+    request get request-aside
     set-aside ;
 
 M: asides call-responder*

basis/furnace/conversations/conversations.factor

@@ -62,8 +62,7 @@ SYMBOL: conversation-id
 
 : init-conversations ( conversations -- )
     conversations set
-    request get request-conversation-id
-    get-conversation
+    request get request-conversation
     set-conversation ;
 
 M: conversations call-responder*

basis/furnace/recaptcha/recaptcha.factor

@@ -59,7 +59,7 @@ M: recaptcha call-responder*
         { "privatekey" private-key }
         { "remoteip" remote-ip }
     } URL" http://api-verify.recaptcha.net/verify"
-    <post-request> http-request nip parse-recaptcha-response ;
+    http-post nip parse-recaptcha-response ;
 
 : validate-recaptcha-params ( -- )
     {

basis/http/parsers/parsers.factor

@@ -11,14 +11,11 @@ IN: http.parsers
 : except-these ( quots -- parser )
     [ 1|| ] curry except ; inline
 
-: ctl? ( ch -- ? )
-    { [ 0 31 between? ] [ 127 = ] } 1|| ;
-
 : tspecial? ( ch -- ? )
     "()<>@,;:\\\"/[]?={} \t" member? ;
 
 : 'token' ( -- parser )
-    { [ ctl? ] [ tspecial? ] } except-these repeat1 ;
+    { [ control? ] [ tspecial? ] } except-these repeat1 ;
 
 : case-insensitive ( parser -- parser' )
     [ flatten >string >lower ] action ;
@@ -62,7 +59,7 @@ PEG: parse-request-line ( string -- triple )
     ] seq* just ;
 
 : 'text' ( -- parser )
-    [ ctl? ] except ;
+    [ control? ] except ;
 
 : 'response-code' ( -- parser )
     [ digit? ] satisfy 3 exactly-n [ string>number ] action ;
@@ -88,7 +85,7 @@ PEG: parse-response-line ( string -- triple )
     [ " \t" member? ] satisfy repeat1 ;
 
 : 'qdtext' ( -- parser )
-    { [ CHAR: " = ] [ ctl? ] } except-these ;
+    { [ CHAR: " = ] [ control? ] } except-these ;
 
 : 'quoted-char' ( -- parser )
     "\\" token hide any-char 2seq ;
@@ -97,7 +94,7 @@ PEG: parse-response-line ( string -- triple )
     'quoted-char' 'qdtext' 2choice repeat0 "\"" "\"" surrounded-by ;
 
 : 'ctext' ( -- parser )
-    { [ ctl? ] [ "()" member? ] } except-these ;
+    { [ control? ] [ "()" member? ] } except-these ;
 
 : 'comment' ( -- parser )
     'ctext' 'comment' 2choice repeat0 "(" ")" surrounded-by ;

basis/ui/tools/browser/popups/popups.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs definitions fry help.topics kernel
+USING: accessors arrays assocs definitions fry help kernel
 colors.constants math.rectangles models.arrow namespaces sequences
 sorting definitions.icons tools.crossref ui.gadgets ui.gadgets.glass
 ui.gadgets.labeled ui.gadgets.scrollers ui.gadgets.tables
@@ -18,14 +18,11 @@ M: link-renderer row-value drop first ;
 
 TUPLE: links-popup < wrapper ;
 
-: sorted-links ( links -- alist )
-    [ dup article-title ] { } map>assoc sort-values ;
-
 : match? ( value str -- ? )
     swap second subseq? ;
 
 : <links-table> ( model quot -- table )
-    '[ @ sorted-links ] <arrow>
+    '[ @ sort-articles ] <arrow>
     link-renderer [ second ] <search-table>
         [ invoke-primary-operation ] >>action
         [ hide-glass ] >>hook

core/classes/tuple/parser/parser.factor

@@ -69,7 +69,7 @@ ERROR: bad-literal-tuple ;
 ERROR: bad-slot-name class slot ;
 
 : check-slot-name ( class slots name -- name )
-    2dup swap slot-named* nip [ 2nip ] [ nip bad-slot-name ] if ;
+    2dup swap slot-named [ 2nip ] [ nip bad-slot-name ] if ;
 
 : parse-slot-value ( class slots -- )
     scan-token check-slot-name scan-object 2array , scan-token {

core/growable/growable.factor

@@ -25,11 +25,8 @@ M: growable contract ( len seq -- )
     [ [ 0 ] 2dip set-nth-unsafe ] curry
     (each-integer) ; inline
 
-: growable-check ( n seq -- n seq )
-    over 0 < [ bounds-error ] when ; inline
-
 M: growable set-length ( n seq -- )
-    growable-check
+    bounds-check-head
     2dup length < [
         2dup contract
     ] [
@@ -40,7 +37,7 @@ M: growable set-length ( n seq -- )
 : new-size ( old -- new ) 1 + 3 * ; inline
 
 : ensure ( n seq -- n seq )
-    growable-check
+    bounds-check-head
     2dup length >= [
         2dup capacity >= [ over new-size over expand ] when
         [ >fixnum ] dip
@@ -60,7 +57,7 @@ M: growable lengthen ( n seq -- )
     ] when 2drop ; inline
 
 M: growable shorten ( n seq -- )
-    growable-check
+    bounds-check-head
     2dup length < [
         2dup contract
         2dup length<<

core/sequences/sequences.factor

@@ -288,8 +288,11 @@ C: <copy> copy-state
     [ over - check-length swap ] dip
     3dup nip new-sequence 0 swap <copy> ; inline
 
+: bounds-check-head ( n seq -- n seq )
+    over 0 < [ bounds-error ] when ; inline
+
 : check-copy ( src n dst -- src n dst )
-    3dup over 0 < [ bounds-error ] when
+    3dup bounds-check-head
     [ swap length + ] dip lengthen ; inline
 
 PRIVATE>
@@ -411,7 +414,7 @@ PRIVATE>
     pick [ [ (each-index) ] dip call ] dip finish-find ; inline
 
 : (accumulate) ( seq identity quot -- identity seq quot )
-    [ swap ] dip [ curry keep ] curry ; inline
+    swapd [ curry keep ] curry ; inline
 
 PRIVATE>
 

core/sets/sets.factor

@@ -128,10 +128,10 @@ M: sequence cardinality
     [ [ f fast-set ] unless* [ adjoin ] keep ] change-at ;
 
 : within ( seq set -- subseq )
-    fast-set [ in? ] curry filter ;
+    tester filter ;
 
 : without ( seq set -- subseq )
-    fast-set [ in? not ] curry filter ;
+    tester [ not ] compose filter ;
 
 ! Temporarily for compatibility
 

extra/lint/lint.factor

@@ -31,13 +31,14 @@ SYMBOL: lint-definitions-keys
 
 CONSTANT: trivial-defs
     {
-        [ drop ] [ 2array ]
+        [ drop ] [ 2drop ] [ 2array ]
         [ bitand ]
         [ . ]
+        [ new ]
         [ get ]
         [ t ] [ f ]
         [ { } ]
-        [ drop f ] [ 2drop ] [ 2drop t ]
+        [ drop t ] [ drop f ] [ 2drop t ] [ 2drop f ]
         [ cdecl ]
         [ first ] [ second ] [ third ] [ fourth ]
         [ ">" write ] [ "/>" write ]
@@ -165,4 +166,7 @@ M: word run-lint ( word -- seq ) 1array run-lint ;
 
 : lint-vocab ( vocab -- seq ) words run-lint dup lint. ;
 
+: lint-vocabs ( prefix -- seq )
+    [ vocabs ] dip [ head? ] curry filter [ lint-vocab ] map ;
+
 : lint-word ( word -- seq ) 1array run-lint dup lint. ;