Change the way %coverage works, make coverage word use map-words to hit private vocabs, make %coverage only work on vocabs.

db4
Doug Coleman 2011-08-27 15:54:25 -05:00
parent 87e64b3a59
commit 2e7935d66e
2 changed files with 13 additions and 20 deletions

View File

@ -17,10 +17,10 @@ HELP: each-word
}
{ $description "Calls a quotation on every word in the vocabulary and its private vocabulary, if there is one." } ;
HELP: map-word
HELP: map-words
{ $values
{ "string" string } { "quot" quotation }
{ "seq" sequence }
{ "sequence" sequence }
}
{ $description "Calls a quotation on every word in the vocabulary and its private vocabulary, if there is one, and collects the results." } ;
@ -57,7 +57,7 @@ HELP: coverage.
HELP: %coverage
{ $values
{ "object" object }
{ "string" string }
{ "x" double }
}
{ $description "Returns a fraction representing the number of quotations called compared to the number of quotations that exist in a vocabulary or word." } ;
@ -69,6 +69,6 @@ ARTICLE: "tools.coverage" "Coverage tool"
"Examining coverage data:"
{ $subsections coverage coverage. %coverage }
"Combinators for iterating over words in a vocabulary:"
{ $subsections each-word map-word } ;
{ $subsections each-word map-words } ;
ABOUT: "tools.coverage"

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry io kernel math prettyprint
quotations sequences sequences.deep splitting strings
tools.annotations vocabs words ;
tools.annotations vocabs words arrays ;
IN: tools.coverage
TUPLE: coverage < identity-tuple executed? ;
@ -28,7 +28,7 @@ PRIVATE>
[ [ words ] dip each ] 2bi
] if ; inline
: map-word ( string quot -- seq )
: map-words ( string quot -- sequence )
over ".private" tail? [
[ words ] dip map
] [
@ -67,7 +67,7 @@ M: word toggle-coverage
GENERIC: coverage ( object -- seq )
M: string coverage
words [ dup coverage ] { } map>assoc ;
[ dup coverage 2array ] map-words ;
M: word coverage ( word -- seq )
"coverage" word-prop >alist
@ -83,7 +83,7 @@ M: word coverage.
drop
] [
[ name>> ":" append print ]
[ [ bl bl bl bl . ] each ] bi*
[ [ " " write . ] each ] bi*
] if-empty ;
<PRIVATE
@ -91,20 +91,13 @@ M: word coverage.
GENERIC: count-callables ( object -- n )
M: string count-callables
[ count-callables ] map-word sum ;
[ count-callables ] map-words sum ;
M: word count-callables
def>> [ callable? ] deep-filter length ;
: calculate-%coverage ( object quot -- x )
[ count-callables ] bi [ swap - ] keep /f ; inline
"coverage" word-prop assoc-size ;
PRIVATE>
GENERIC: %coverage ( object -- x )
M: string %coverage
[ coverage values concat length ] calculate-%coverage ;
M: word %coverage
[ coverage length ] calculate-%coverage ;
: %coverage ( string -- x )
[ coverage values concat length ]
[ count-callables ] bi [ swap - ] keep /f ; inline