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

tools.coverage: cleanup and use deep-reduce in count-callables.

db4
John Benediktsson 2015-06-09 08:43:51 -07:00
parent a732c2afc5
commit 6698f7d55d
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,8 +3,7 @@
USING: accessors arrays assocs classes combinators.short-circuit USING: accessors arrays assocs classes combinators.short-circuit
continuations fry io kernel math namespaces prettyprint continuations fry io kernel math namespaces prettyprint
quotations sequences sequences.deep splitting strings quotations sequences sequences.deep splitting strings
tools.annotations tools.test.private vocabs vocabs.hierarchy tools.annotations tools.test.private vocabs words words.symbol ;
words words.symbol ;
IN: tools.coverage IN: tools.coverage
TUPLE: coverage-state < identity-tuple executed? ; TUPLE: coverage-state < identity-tuple executed? ;
@ -32,7 +31,13 @@ GENERIC: reset-coverage ( object -- )
".private" ?tail drop ".private" append ; ".private" ?tail drop ".private" append ;
: coverage-words ( string -- words ) : coverage-words ( string -- words )
vocab-words [ { [ primitive? not ] [ symbol? not ] [ predicate? not ] } 1&& ] filter ; vocab-words [
{
[ primitive? not ]
[ symbol? not ]
[ predicate? not ]
} 1&&
] filter ;
PRIVATE> PRIVATE>
@ -80,7 +85,7 @@ M: string coverage
[ dup coverage 2array ] map-words ; [ dup coverage 2array ] map-words ;
M: word coverage ( word -- seq ) M: word coverage ( word -- seq )
"coverage" word-prop >alist "coverage" word-prop
[ drop executed?>> ] assoc-reject values ; [ drop executed?>> ] assoc-reject values ;
GENERIC: coverage. ( object -- ) GENERIC: coverage. ( object -- )
@ -88,13 +93,11 @@ GENERIC: coverage. ( object -- )
M: string coverage. M: string coverage.
[ coverage. ] each-word ; [ coverage. ] each-word ;
: pair-coverage. ( word quots -- ) : pair-coverage. ( word seq -- )
dup empty? [ [ drop ] [
2drop
] [
[ name>> ":" append print ] [ name>> ":" append print ]
[ [ " " write . ] each ] bi* [ [ " " write . ] each ] bi*
] if ; ] if-empty ;
M: word coverage. M: word coverage.
dup coverage pair-coverage. ; dup coverage pair-coverage. ;
@ -110,7 +113,7 @@ M: string count-callables
[ count-callables ] map-words sum ; [ count-callables ] map-words sum ;
M: word count-callables M: word count-callables
def>> [ callable? ] deep-filter length ; def>> 0 [ callable? [ 1 + ] when ] deep-reduce ;
PRIVATE> PRIVATE>