From 378786599dcca07a08e3b326814334771fdf1d79 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 14 Oct 2011 10:23:52 -0700 Subject: [PATCH] Cleanup lint warnings. --- basis/alien/parser/parser.factor | 2 +- .../classes/struct/bit-accessors/bit-accessors.factor | 5 +++-- basis/compiler/cfg/liveness/liveness.factor | 2 +- .../cfg/representations/selection/selection.factor | 2 +- .../cfg/stacks/uninitialized/uninitialized.factor | 2 +- .../tree/modular-arithmetic/modular-arithmetic.factor | 2 +- .../tree/propagation/inlining/inlining.factor | 2 +- .../tree/tuple-unboxing/tuple-unboxing.factor | 2 +- basis/farkup/farkup.factor | 3 +-- basis/furnace/asides/asides.factor | 3 +-- basis/furnace/conversations/conversations.factor | 3 +-- basis/furnace/recaptcha/recaptcha.factor | 2 +- basis/http/parsers/parsers.factor | 11 ++++------- basis/ui/tools/browser/popups/popups.factor | 7 ++----- core/classes/tuple/parser/parser.factor | 2 +- core/growable/growable.factor | 9 +++------ core/sequences/sequences.factor | 7 +++++-- core/sets/sets.factor | 4 ++-- extra/lint/lint.factor | 8 ++++++-- 19 files changed, 37 insertions(+), 41 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index d4824507d2..39599d6d83 100755 --- a/basis/alien/parser/parser.factor +++ b/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 "<" = diff --git a/basis/classes/struct/bit-accessors/bit-accessors.factor b/basis/classes/struct/bit-accessors/bit-accessors.factor index c5959ab7ac..a801538796 100644 --- a/basis/classes/struct/bit-accessors/bit-accessors.factor +++ b/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 ) diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index 772e4f390f..2c6bcdfa47 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/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 ; diff --git a/basis/compiler/cfg/representations/selection/selection.factor b/basis/compiler/cfg/representations/selection/selection.factor index d0e156f31e..3d435edc09 100644 --- a/basis/compiler/cfg/representations/selection/selection.factor +++ b/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 diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor index 7ceb867dbc..eadfe0aa91 100644 --- a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor +++ b/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> diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index a737b97023..55669f06c1 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/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? { diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 5375ff6881..6b40232412 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/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 ; diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor index d4ca3010ce..b13334e5d0 100644 --- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor +++ b/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 ; diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 9473ccedfb..439c50b144 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -104,7 +104,6 @@ DEFER: (parse-paragraph) : ( 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 ) - [ dup done? not ] [ parse-item ] produce nip sift ; + [ dup empty? not ] [ parse-item ] produce nip sift ; CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');" diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor index 254cb04fed..4f2568b636 100644 --- a/basis/furnace/asides/asides.factor +++ b/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* diff --git a/basis/furnace/conversations/conversations.factor b/basis/furnace/conversations/conversations.factor index 82a4de2429..be10a1d30b 100644 --- a/basis/furnace/conversations/conversations.factor +++ b/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* diff --git a/basis/furnace/recaptcha/recaptcha.factor b/basis/furnace/recaptcha/recaptcha.factor index 4ac03ce839..3ae20f14bb 100644 --- a/basis/furnace/recaptcha/recaptcha.factor +++ b/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" - http-request nip parse-recaptcha-response ; + http-post nip parse-recaptcha-response ; : validate-recaptcha-params ( -- ) { diff --git a/basis/http/parsers/parsers.factor b/basis/http/parsers/parsers.factor index 9c81510925..475074d378 100644 --- a/basis/http/parsers/parsers.factor +++ b/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 ; diff --git a/basis/ui/tools/browser/popups/popups.factor b/basis/ui/tools/browser/popups/popups.factor index ac4318fa92..b5ceda461e 100644 --- a/basis/ui/tools/browser/popups/popups.factor +++ b/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? ; : ( model quot -- table ) - '[ @ sorted-links ] + '[ @ sort-articles ] link-renderer [ second ] [ invoke-primary-operation ] >>action [ hide-glass ] >>hook diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 1bc1067724..701a4b7604 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/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 { diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 8d52c98c71..0144cdf58f 100644 --- a/core/growable/growable.factor +++ b/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<< diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 32cbce114f..0426a8bd9c 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -288,8 +288,11 @@ C: copy-state [ over - check-length swap ] dip 3dup nip new-sequence 0 swap ; 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> diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 3b5192b008..1c4a344612 100644 --- a/core/sets/sets.factor +++ b/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 diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index 71c69796e6..ce1708f9bf 100644 --- a/extra/lint/lint.factor +++ b/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. ;