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

refactor lint, add lint-vocab/lint-word

db4
Doug Coleman 2008-01-12 20:30:43 -10:00
parent 304aa98fe7
commit 11dcb41546
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
extra/lint/lint.factor
View File

@ -121,7 +121,7 @@ M: word lint ( word -- seq )
: word-path. ( word -- ) : word-path. ( word -- )
[ word-vocabulary ":" ] keep unparse 3append write nl ; [ word-vocabulary ":" ] keep unparse 3append write nl ;
: lint. ( array -- ) : (lint.) ( pair -- )
first2 >r word-path. r> [ first2 >r word-path. r> [
bl bl bl bl bl bl bl bl
dup . dup .
@ -129,6 +129,9 @@ M: word lint ( word -- seq )
def-hash get at [ bl bl bl bl word-path. ] each def-hash get at [ bl bl bl bl word-path. ] each
nl nl
] each nl nl ; ] each nl nl ;
: lint. ( alist -- )
[ (lint.) ] each ;
GENERIC: run-lint ( obj -- obj ) GENERIC: run-lint ( obj -- obj )
@ -143,21 +146,29 @@ GENERIC: run-lint ( obj -- obj )
: trim-self ( seq -- newseq ) : trim-self ( seq -- newseq )
[ [ (trim-self) ] subset ] assoc-map ; [ [ (trim-self) ] subset ] assoc-map ;
: filter-symbols ( alist -- alist )
[
nip first dup def-hash get at
[ first ] 2apply literalize = not
] assoc-subset ;
M: sequence run-lint ( seq -- seq ) M: sequence run-lint ( seq -- seq )
[ [
global [ dup . flush ] bind global [ dup . flush ] bind
dup lint dup lint
] { } map>assoc ] { } map>assoc
trim-self trim-self
[ second empty? not ] subset ; [ second empty? not ] subset
filter-symbols ;
M: word run-lint ( word -- seq ) M: word run-lint ( word -- seq )
1array run-lint ; 1array run-lint ;
: lint-all ( -- seq ) : lint-all ( -- seq )
all-words run-lint all-words run-lint dup lint. ;
[
nip first dup def-hash get at : lint-vocab ( vocab -- seq )
[ first ] 2apply literalize = not words run-lint dup lint. ;
] assoc-subset
dup [ lint. ] each ; : lint-word ( word -- seq )
1array run-lint dup lint. ;