Revive the lint tool
parent
0965d9be41
commit
6586b97128
|
@ -1,19 +1,18 @@
|
||||||
! 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 alien.accessors arrays assocs
|
USING: accessors alien arrays assocs combinators.short-circuit
|
||||||
combinators.short-circuit fry hashtables io
|
fry hashtables io kernel math namespaces prettyprint quotations
|
||||||
kernel math namespaces prettyprint quotations sequences
|
sequences sequences.deep shuffle slots.private vectors vocabs
|
||||||
sequences.deep sets slots.private vectors vocabs words
|
words xml.data ;
|
||||||
kernel.private ;
|
|
||||||
IN: lint
|
IN: lint
|
||||||
|
|
||||||
SYMBOL: def-hash
|
SYMBOL: lint-definitions
|
||||||
SYMBOL: def-hash-keys
|
SYMBOL: lint-definitions-keys
|
||||||
|
|
||||||
: set-hash-vector ( val key hash -- )
|
: set-hash-vector ( val key hash -- )
|
||||||
2dup at -rot [ ?push ] 2dip set-at ;
|
2dup at -rot [ ?push ] 2dip set-at ;
|
||||||
|
|
||||||
: more-defs ( hash -- )
|
: manual-substitutions ( hash -- )
|
||||||
{
|
{
|
||||||
{ -rot [ swap [ swap ] dip ] }
|
{ -rot [ swap [ swap ] dip ] }
|
||||||
{ -rot [ swap swapd ] }
|
{ -rot [ swap swapd ] }
|
||||||
|
@ -30,45 +29,32 @@ SYMBOL: def-hash-keys
|
||||||
{ >boolean [ f = not ] }
|
{ >boolean [ f = not ] }
|
||||||
} swap '[ first2 _ set-hash-vector ] each ;
|
} swap '[ first2 _ set-hash-vector ] each ;
|
||||||
|
|
||||||
: accessor-words ( -- seq )
|
CONSTANT: trivial-defs
|
||||||
{
|
|
||||||
alien-signed-1 alien-signed-2 alien-signed-4 alien-signed-8
|
|
||||||
alien-unsigned-1 alien-unsigned-2 alien-unsigned-4 alien-unsigned-8
|
|
||||||
<displaced-alien> alien-unsigned-cell set-alien-signed-cell
|
|
||||||
set-alien-unsigned-1 set-alien-signed-1 set-alien-unsigned-2
|
|
||||||
set-alien-signed-2 set-alien-unsigned-4 set-alien-signed-4
|
|
||||||
set-alien-unsigned-8 set-alien-signed-8
|
|
||||||
alien-cell alien-signed-cell set-alien-cell set-alien-unsigned-cell
|
|
||||||
set-alien-float alien-float
|
|
||||||
} ;
|
|
||||||
|
|
||||||
: trivial-defs ( -- seq )
|
|
||||||
{
|
{
|
||||||
[ drop ] [ 2array ]
|
[ drop ] [ 2array ]
|
||||||
[ bitand ]
|
[ bitand ]
|
||||||
|
|
||||||
[ . ]
|
[ . ]
|
||||||
[ get ]
|
[ get ]
|
||||||
[ t ] [ f ]
|
[ t ] [ f ]
|
||||||
[ { } ]
|
[ { } ]
|
||||||
[ drop f ]
|
[ drop f ] [ 2drop ] [ 2drop t ]
|
||||||
[ cdecl ]
|
[ cdecl ]
|
||||||
[ first ] [ second ] [ third ] [ fourth ]
|
[ first ] [ second ] [ third ] [ fourth ]
|
||||||
[ ">" write ] [ "/>" write ]
|
[ ">" write ] [ "/>" write ]
|
||||||
} ;
|
}
|
||||||
|
|
||||||
! ! Add definitions
|
! ! Add definitions
|
||||||
H{ } clone def-hash set-global
|
H{ } clone lint-definitions set-global
|
||||||
|
|
||||||
all-words [
|
all-words [
|
||||||
dup def>> dup callable?
|
dup def>> dup callable?
|
||||||
[ def-hash get-global set-hash-vector ] [ drop ] if
|
[ lint-definitions get-global set-hash-vector ] [ drop ] if
|
||||||
] each
|
] each
|
||||||
|
|
||||||
! ! Remove definitions
|
! ! Remove definitions
|
||||||
|
|
||||||
! Remove empty word defs
|
! Remove empty word defs
|
||||||
def-hash get-global [ drop empty? not ] assoc-filter
|
lint-definitions get-global [ drop empty? not ] assoc-filter
|
||||||
|
|
||||||
! Remove constants [ 1 ]
|
! Remove constants [ 1 ]
|
||||||
[ drop { [ length 1 = ] [ first number? ] } 1&& not ] assoc-filter
|
[ drop { [ length 1 = ] [ first number? ] } 1&& not ] assoc-filter
|
||||||
|
@ -76,8 +62,10 @@ def-hash get-global [ drop empty? 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
|
||||||
|
|
||||||
! Remove set-alien-cell, etc.
|
! Remove specialized*
|
||||||
[ drop [ accessor-words diff ] keep [ length ] bi@ = ] assoc-filter
|
[ nip [ vocabulary>> "specialized-" head? ] any? not ] assoc-filter
|
||||||
|
|
||||||
|
[ nip [ vocabulary>> "windows.messages" = ] any? not ] assoc-filter
|
||||||
|
|
||||||
! Remove trivial defs
|
! Remove trivial defs
|
||||||
[ drop trivial-defs member? not ] assoc-filter
|
[ drop trivial-defs member? not ] assoc-filter
|
||||||
|
@ -117,13 +105,12 @@ def-hash get-global [ drop empty? not ] assoc-filter
|
||||||
[ first2 [ number? ] [ \ slot = ] bi* and not ] [ drop t ] if
|
[ first2 [ number? ] [ \ slot = ] bi* and not ] [ drop t ] if
|
||||||
] assoc-filter
|
] assoc-filter
|
||||||
|
|
||||||
|
dup manual-substitutions
|
||||||
|
|
||||||
dup more-defs
|
[ lint-definitions set-global ] [ keys lint-definitions-keys set-global ] bi
|
||||||
|
|
||||||
[ def-hash set-global ] [ keys def-hash-keys set-global ] bi
|
|
||||||
|
|
||||||
: find-duplicates ( -- seq )
|
: find-duplicates ( -- seq )
|
||||||
def-hash get-global [ nip length 1 > ] assoc-filter ;
|
lint-definitions get-global [ nip length 1 > ] assoc-filter ;
|
||||||
|
|
||||||
GENERIC: lint ( obj -- seq )
|
GENERIC: lint ( obj -- seq )
|
||||||
|
|
||||||
|
@ -133,20 +120,20 @@ M: object lint ( obj -- seq ) drop f ;
|
||||||
{ [ start ] [ member? ] } 2|| ;
|
{ [ start ] [ member? ] } 2|| ;
|
||||||
|
|
||||||
M: callable lint ( quot -- seq )
|
M: callable lint ( quot -- seq )
|
||||||
[ def-hash-keys get-global ] dip '[ _ subseq/member? ] filter ;
|
[ lint-definitions-keys get-global ] dip '[ _ subseq/member? ] filter ;
|
||||||
|
|
||||||
M: word lint ( word -- seq )
|
M: word lint ( word -- seq )
|
||||||
def>> dup callable? [ lint ] [ drop f ] if ;
|
def>> dup callable? [ lint ] [ drop f ] if ;
|
||||||
|
|
||||||
: word-path. ( word -- )
|
: word-path. ( word -- )
|
||||||
[ vocabulary>> ] [ unparse ] bi ":" glue print ;
|
[ vocabulary>> ] [ name>> ] bi ":" glue print ;
|
||||||
|
|
||||||
: 4bl ( -- ) bl bl bl bl ;
|
: 4bl ( -- ) bl bl bl bl ;
|
||||||
|
|
||||||
: (lint.) ( pair -- )
|
: (lint.) ( pair -- )
|
||||||
first2 [ word-path. ] dip [
|
first2 [ word-path. ] dip [
|
||||||
[ 4bl . "-----------------------------------" print ]
|
[ 4bl . "-----------------------------------" print ]
|
||||||
[ def-hash get-global at [ 4bl word-path. ] each nl ] bi
|
[ lint-definitions get-global at [ 4bl word-path. ] each nl ] bi
|
||||||
] each nl nl ;
|
] each nl nl ;
|
||||||
|
|
||||||
: lint. ( alist -- ) [ (lint.) ] each ;
|
: lint. ( alist -- ) [ (lint.) ] each ;
|
||||||
|
@ -154,7 +141,7 @@ M: word lint ( word -- seq )
|
||||||
GENERIC: run-lint ( obj -- obj )
|
GENERIC: run-lint ( obj -- obj )
|
||||||
|
|
||||||
: (trim-self) ( val key -- obj ? )
|
: (trim-self) ( val key -- obj ? )
|
||||||
def-hash get-global at*
|
lint-definitions get-global at*
|
||||||
[ dupd remove empty? not ] [ drop f ] if ;
|
[ dupd remove empty? not ] [ drop f ] if ;
|
||||||
|
|
||||||
: trim-self ( seq -- newseq )
|
: trim-self ( seq -- newseq )
|
||||||
|
@ -162,7 +149,7 @@ GENERIC: run-lint ( obj -- obj )
|
||||||
|
|
||||||
: filter-symbols ( alist -- alist )
|
: filter-symbols ( alist -- alist )
|
||||||
[
|
[
|
||||||
nip first dup def-hash get-global at
|
nip first dup lint-definitions get-global at
|
||||||
[ first ] bi@ literalize = not
|
[ first ] bi@ literalize = not
|
||||||
] assoc-filter ;
|
] assoc-filter ;
|
||||||
|
|
Loading…
Reference in New Issue