steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lint: filter a bit better.

db4
John Benediktsson 2011-10-16 19:32:16 -07:00
parent 470e0be3e1
commit 45aeea52ce
1 changed files with 29 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
extra/lint/lint.factor
View File

@ -1,10 +1,12 @@
! Copyright (C) 2007, 2008 Doug Coleman. ! Copyright (C) 2007, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays assocs classes.tuple.private
combinators.short-circuit fry hashtables io kernel USING: accessors alien arrays assocs classes
locals.backend make math namespaces prettyprint quotations classes.tuple.private combinators.short-circuit fry hashtables
sequences sequences.deep shuffle slots.private vectors vocabs io kernel kernel.private locals.backend make math namespaces
words xml.data words.alias ; prettyprint quotations sequences sequences.deep shuffle
slots.private vectors vocabs words words.alias ;
IN: lint IN: lint
<PRIVATE <PRIVATE
@ -33,14 +35,16 @@ CONSTANT: trivial-defs
[ 3drop t ] [ 3drop f ] [ 3drop t ] [ 3drop f ]
[ ">" write ] [ "/>" write ] [ ">" write ] [ "/>" write ]
[ length 1 - ] [ length 1 = ] [ length 1 > ] [ length 1 - ] [ length 1 = ] [ length 1 > ]
[ drop f f ] [ 2drop f f ] [ drop f f ] [ drop f t ] [ drop t f ] [ drop t t ]
[ 2drop f f ] [ 2drop f t ] [ 2drop t f ] [ 2drop t t ]
[ drop f f f ] [ drop f f f ]
[ nip f f ] [ nip f f ]
[ 0 or + ] [ 0 or + ]
[ dup 0 > ] [ dup 0 <= ] [ dup 0 > ] [ dup 0 <= ] [ dup 0 < ]
[ over 0 > ] [ over 0 <= ] [ over 0 < ]
[ dup length iota ] [ dup length iota ]
[ 0 swap copy ] [ 0 swap copy ]
[ dup 1 + ] [ dup 1 + ] [ drop 1 + ]
} }
: lintable-word? ( word -- ? ) : lintable-word? ( word -- ? )
@ -72,7 +76,7 @@ CONSTANT: trivial-defs
[ { [ number? ] [ t? ] [ f eq? ] } 1|| ] all? [ { [ number? ] [ t? ] [ f eq? ] } 1|| ] all?
] ]
! Remove tag defs ! Remove [ tag n eq? ]
[ [
{ {
[ length 3 = ] [ length 3 = ]
@ -80,6 +84,16 @@ CONSTANT: trivial-defs
} 1&& } 1&&
] ]
! Remove [ { foo } declare class ]
[
{
[ length 3 = ]
[ first { [ array? ] [ length 1 = ] } 1&& ]
[ second \ declare = ]
[ third \ class = ]
} 1&&
]
! Remove [ m n shift ] ! Remove [ m n shift ]
[ [
{ {
@ -97,10 +111,15 @@ CONSTANT: trivial-defs
[ third \ slot = ] [ third \ slot = ]
} 1&& } 1&&
] ]
! Remove [ ... \ cdecl ]
[
{ [ length 3 = ] [ last \ cdecl = ] } 1&&
]
} 1|| ; } 1|| ;
: all-callables ( def -- seq ) : all-callables ( def -- seq )
[ callable? ] deep-filter ; [ { [ callable? ] [ ignore-def? not ] } 1&& ] deep-filter ;
: (load-definitions) ( word def hash -- ) : (load-definitions) ( word def hash -- )
[ all-callables ] dip '[ _ push-at ] with each ; [ all-callables ] dip '[ _ push-at ] with each ;
@ -114,7 +133,6 @@ SYMBOL: lint-definitions-keys
: reload-definitions ( -- ) : reload-definitions ( -- )
! Load lintable and non-ignored definitions ! Load lintable and non-ignored definitions
lintable-words load-definitions lintable-words load-definitions
[ drop ignore-def? not ] assoc-filter
! Remove words that are their own definition ! Remove words that are their own definition
[ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map [ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map