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

Make coverage. use each-word, only put coverage on non-primitive/symbol words

db4
Doug Coleman 2011-08-27 16:12:41 -05:00
parent 2e7935d66e
commit 05de404801
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/tools/coverage/coverage.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry io kernel math prettyprint USING: accessors assocs fry io kernel math prettyprint
quotations sequences sequences.deep splitting strings quotations sequences sequences.deep splitting strings
tools.annotations vocabs words arrays ; tools.annotations vocabs words arrays words.symbol
combinators.short-circuit ;
IN: tools.coverage IN: tools.coverage
TUPLE: coverage < identity-tuple executed? ; TUPLE: coverage < identity-tuple executed? ;
@ -18,22 +19,25 @@ GENERIC: coverage-off ( object -- )
: private-vocab-name ( string -- string' ) : private-vocab-name ( string -- string' )
".private" ?tail drop ".private" append ; ".private" ?tail drop ".private" append ;
: coverage-words ( string -- words )
words [ { [ primitive? not ] [ symbol? not ] } 1&& ] filter ;
PRIVATE> PRIVATE>
: each-word ( string quot -- ) : each-word ( string quot -- )
over ".private" tail? [ over ".private" tail? [
[ words ] dip each [ coverage-words ] dip each
] [ ] [
[ [ private-vocab-name words ] dip each ] [ [ private-vocab-name coverage-words ] dip each ]
[ [ words ] dip each ] 2bi [ [ coverage-words ] dip each ] 2bi
] if ; inline ] if ; inline
: map-words ( string quot -- sequence ) : map-words ( string quot -- sequence )
over ".private" tail? [ over ".private" tail? [
[ words ] dip map [ coverage-words ] dip map
] [ ] [
[ [ private-vocab-name words ] dip map ] [ [ private-vocab-name coverage-words ] dip map ]
[ [ words ] dip map ] 2bi append [ [ coverage-words ] dip map ] 2bi append
] if ; inline ] if ; inline
M: string coverage-on M: string coverage-on
@ -76,7 +80,7 @@ M: word coverage ( word -- seq )
GENERIC: coverage. ( object -- ) GENERIC: coverage. ( object -- )
M: string coverage. M: string coverage.
words [ coverage. ] each ; [ coverage. ] each-word ;
M: word coverage. M: word coverage.
dup coverage [ dup coverage [