Browse files

Cleanup more lint warnings.

  • Loading branch information...
1 parent 1e38c6f commit eb55f8575cfdf0597bef1e95f63db74ee37454c6 @mrjbq7 mrjbq7 committed Oct 14, 2011
View
7 basis/alien/parser/parser.factor
@@ -9,9 +9,6 @@ IN: alien.parser
SYMBOL: current-library
-: parse-c-type-name ( name -- word )
- dup search [ ] [ no-word ] ?if ;
-
DEFER: (parse-c-type)
ERROR: bad-array-type ;
@@ -26,8 +23,8 @@ ERROR: bad-array-type ;
{
{ [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
{ [ CHAR: ] over member? ] [ parse-array-type ] }
- { [ dup search ] [ parse-c-type-name ] }
- [ dup search [ ] [ no-word ] ?if ]
+ { [ dup search ] [ parse-word ] }
+ [ parse-word ]
} cond ;
: c-array? ( c-type -- ? )
View
2 basis/bitstreams/bitstreams.factor
@@ -49,7 +49,7 @@ TUPLE: lsb0-bit-writer < bit-writer ;
: new-bit-writer ( class -- bs )
new
BV{ } clone >>bytes
- 0 0 <widthed> >>widthed ; inline
+ zero-widthed >>widthed ; inline
: <msb0-bit-writer> ( -- bs )
msb0-bit-writer new-bit-writer ;
View
3 basis/db/tuples/tuples.factor
@@ -131,8 +131,7 @@ ERROR: no-defined-persistent object ;
: ensure-tables ( classes -- ) [ ensure-table ] each ;
: insert-tuple ( tuple -- )
- dup class ensure-defined-persistent
- db-columns find-primary-key db-assigned-id-spec?
+ dup class ensure-defined-persistent db-assigned?
[ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ;
: update-tuple ( tuple -- )
View
3 basis/db/types/types.factor
@@ -38,8 +38,7 @@ SYMBOL: IGNORE
ERROR: no-slot ;
: offset-of-slot ( string tuple -- n )
- class superclasses [ "slots" word-prop ] map concat
- slot-named dup [ no-slot ] unless offset>> ;
+ class all-slots slot-named dup [ no-slot ] unless offset>> ;
: get-slot-named ( name tuple -- value )
[ nip ] [ offset-of-slot ] 2bi slot ;
View
2 basis/editors/editors.factor
@@ -16,7 +16,7 @@ M: no-edit-hook summary
SYMBOL: edit-hook
: available-editors ( -- seq )
- "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ;
+ "editors" child-vocab-names ;
: editor-restarts ( -- alist )
available-editors
View
14 basis/farkup/farkup.factor
@@ -102,9 +102,7 @@ DEFER: (parse-paragraph)
] [ drop "" like 1list ] if*
] if-empty ;
-: <farkup-state> ( string -- state ) string-lines ;
: look ( state i -- char ) swap first ?nth ;
-: take-line ( state -- state' line ) unclip-slice ;
: take-lines ( state char -- state' lines )
dupd '[ ?first _ = not ] find drop
@@ -136,7 +134,7 @@ DEFER: (parse-paragraph)
[ trim= parse-paragraph ] dip boa ; inline
: parse-heading ( state -- state' heading )
- take-line dup count= {
+ unclip-slice dup count= {
{ 0 [ make-paragraph ] }
{ 1 [ heading1 make-heading ] }
{ 2 [ heading2 make-heading ] }
@@ -168,7 +166,7 @@ DEFER: (parse-paragraph)
] map table boa ;
: parse-line ( state -- state' item )
- take-line dup "___" =
+ unclip-slice dup "___" =
[ drop line new ] [ make-paragraph ] if ;
: parse-list ( state char class -- state' list )
@@ -185,12 +183,12 @@ DEFER: (parse-paragraph)
: parse-code ( state -- state' item )
dup 1 look CHAR: [ =
- [ take-line make-paragraph ] [
+ [ unclip-slice make-paragraph ] [
dup "{" take-until [
[ nip rest ] dip
"}]" take-until
[ code boa ] dip swap
- ] [ drop take-line make-paragraph ] if*
+ ] [ drop unclip-slice make-paragraph ] if*
] if ;
: parse-item ( state -- state' item )
@@ -202,11 +200,11 @@ DEFER: (parse-paragraph)
{ CHAR: # [ parse-ol ] }
{ CHAR: [ [ parse-code ] }
{ f [ rest-slice f ] }
- [ drop take-line make-paragraph ]
+ [ drop unclip-slice make-paragraph ]
} case ;
: parse-farkup ( string -- farkup )
- <farkup-state> [ dup empty? not ] [ parse-item ] produce nip sift ;
+ string-lines [ dup empty? not ] [ parse-item ] produce nip sift ;
CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
View
2 basis/functors/functors.factor
@@ -127,7 +127,7 @@ FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ;
PRIVATE>
-SYNTAX: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ;
+SYNTAX: IS [ parse-word ] (INTERPOLATE) ;
SYNTAX: DEFERS [ current-vocab create ] (INTERPOLATE) ;
View
2 basis/logging/logging.factor
@@ -26,7 +26,7 @@ log-level [ DEBUG ] initialize
ERROR: undefined-log-level ;
: log-level<=> ( log-level log-level -- ? )
- [ log-levels at* [ undefined-log-level ] unless ] bi@ <=> ;
+ [ log-levels at* [ undefined-log-level ] unless ] compare ;
: log? ( log-level -- ? )
log-level get log-level<=> +lt+ = not ;
View
6 basis/peg/peg.factor
@@ -22,9 +22,9 @@ SYMBOL: error-stack
: (merge-errors) ( a b -- c )
{
- { [ over position>> not ] [ nip ] }
- { [ dup position>> not ] [ drop ] }
- [ 2dup [ position>> ] bi@ <=> {
+ { [ over position>> not ] [ nip ] }
+ { [ dup position>> not ] [ drop ] }
+ [ 2dup [ position>> ] compare {
{ +lt+ [ nip ] }
{ +gt+ [ drop ] }
{ +eq+ [ messages>> over messages>> union [ position>> ] dip <parse-error> ] }
View
17 basis/syndication/syndication.factor
@@ -28,8 +28,7 @@ TUPLE: entry title url description date ;
[ rfc822>timestamp ] [ drop rfc3339>timestamp ] recover ;
: rss1.0-entry ( tag -- entry )
- entry new
- swap {
+ <entry> swap {
[ "title" tag-named children>string >>title ]
[ "link" tag-named children>string >url >>url ]
[ "description" tag-named children>string >>description ]
@@ -41,16 +40,14 @@ TUPLE: entry title url description date ;
} cleave ;
: rss1.0 ( xml -- feed )
- feed new
- swap [
+ <feed> swap [
"channel" tag-named
[ "title" tag-named children>string >>title ]
[ "link" tag-named children>string >url >>url ] bi
] [ "item" tags-named [ rss1.0-entry ] map set-entries ] bi ;
: rss2.0-entry ( tag -- entry )
- entry new
- swap {
+ <entry> swap {
[ "title" tag-named children>string >>title ]
[ { "link" "guid" } any-tag-named children>string >url >>url ]
[ { "description" "encoded" } any-tag-named children>string >>description ]
@@ -61,9 +58,8 @@ TUPLE: entry title url description date ;
} cleave ;
: rss2.0 ( xml -- feed )
- feed new
- swap
- "channel" tag-named
+ <feed> swap
+ "channel" tag-named
[ "title" tag-named children>string >>title ]
[ "link" tag-named children>string >url >>url ]
[ "item" tags-named [ rss2.0-entry ] map set-entries ]
@@ -75,8 +71,7 @@ TUPLE: entry title url description date ;
dup [ "href" attr >url ] when ;
: atom1.0-entry ( tag -- entry )
- entry new
- swap {
+ <entry> swap {
[ "title" tag-named children>string >>title ]
[ atom-entry-link >>url ]
[
View
11 basis/validators/validators.factor
@@ -1,15 +1,16 @@
! Copyright (C) 2006, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences math namespaces make sets
-math.parser math.ranges assocs regexp unicode.categories arrays
-hashtables words classes quotations xmode.catalog unicode.case ;
+USING: arrays assocs classes continuations hashtables kernel
+make math math.functions math.parser math.ranges namespaces
+quotations regexp sequences sets unicode.case unicode.categories
+words xmode.catalog ;
IN: validators
: v-checkbox ( str -- ? )
>lower "on" = ;
: v-default ( str def -- str/def )
- [ drop empty? not ] 2keep ? ;
+ [ drop empty? not ] most ;
: v-required ( str -- str )
dup empty? [ "required" throw ] when ;
@@ -94,7 +95,7 @@ IN: validators
: luhn? ( str -- ? )
string>digits <reversed>
[ odd? [ 2 * 10 /mod + ] when ] map-index
- sum 10 mod 0 = ;
+ sum 10 divisor? ;
: v-credit-card ( str -- n )
"- " without
View
2 core/lexer/lexer.factor
@@ -26,7 +26,7 @@ TUPLE: lexer-parsing-word word line line-text column ;
] [ parsing-words>> push ] bi ;
: pop-parsing-word ( -- )
- lexer get parsing-words>> pop drop ;
+ lexer get parsing-words>> pop* ;
: new-lexer ( text class -- lexer )
new
View
3 extra/infix/infix.factor
@@ -77,8 +77,7 @@ M: bad-stack-effect summary
[ = ] dip 1 = and ;
: find-and-check ( args argcount string -- quot )
- dup search [ ] [ no-word ] ?if
- [ nip ] [ check-word ] 2bi
+ parse-word [ nip ] [ check-word ] 2bi
[ 1quotation compose ] [ bad-stack-effect ] if ;
: arguments-codegen ( seq -- quot )
View
1 extra/lint/lint.factor
@@ -36,6 +36,7 @@ CONSTANT: trivial-defs
[ . ]
[ new ]
[ get ]
+ [ "" ]
[ t ] [ f ]
[ { } ]
[ drop t ] [ drop f ] [ 2drop t ] [ 2drop f ]
View
2 extra/pair-methods/pair-methods.factor
@@ -26,7 +26,7 @@ ERROR: no-pair-method a b generic ;
: pair-generic-definition ( word -- def )
[ sorted-pair-methods [ first2 pair-method-cond ] map ]
[ [ no-pair-method ] curry suffix ] bi 1quotation
- [ 2dup [ class ] bi@ <=> +gt+ eq? ?swap ] [ cond ] surround ;
+ [ 2dup [ class ] compare +gt+ eq? ?swap ] [ cond ] surround ;
: make-pair-generic ( word -- )
dup pair-generic-definition define ;
View
2 extra/poker/poker.factor
@@ -215,7 +215,7 @@ ERROR: no-card card deck ;
sampled 2 cut :> ( hole2 community2 )
hole1 community community2 3append :> hand1
hole2 community community2 3append :> hand2
- hand1 hand2 [ best-holdem-hand 2array ] bi@ <=> +lt+ =
+ hand1 hand2 [ best-holdem-hand 2array ] compare +lt+ =
] count ;
:: compare-holdem-hands ( holes deck n -- seq )
View
2 extra/semantic-versioning/semantic-versioning.factor
@@ -13,7 +13,7 @@ IN: semantic-versioning
: version<=> ( version1 version2 -- <=> )
[ split-version ] bi@ drop-prefix
2dup [ length 0 = ] either?
- [ [ length ] bi@ >=< ] [ [ first ] bi@ <=> ] if ;
+ [ [ length ] bi@ >=< ] [ [ first ] compare ] if ;
: version< ( version1 version2 -- ? )
version<=> +lt+ = ;

0 comments on commit eb55f85

Please sign in to comment.