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

Better name for combinator -- each-word, each-map to iterate over all words in vocab and its private vocab. Add count-callables and %coverage words.

db4
Doug Coleman 2011-08-27 12:34:05 -05:00
parent 571d619442
commit 472fe7fa4b
1 changed files with 32 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,7 +17,7 @@ GENERIC: coverage-off ( object -- )
: private-vocab-name ( string -- string' ) : private-vocab-name ( string -- string' )
".private" ?tail drop ".private" append ; ".private" ?tail drop ".private" append ;
: change-vocabulary-coverage ( string quot -- ) : each-word ( string quot -- )
over ".private" tail? [ over ".private" tail? [
[ words ] dip each [ words ] dip each
] [ ] [
@ -25,19 +25,27 @@ GENERIC: coverage-off ( object -- )
[ [ words ] dip each ] 2bi [ [ words ] dip each ] 2bi
] if ; inline ] if ; inline
: map-word ( string quot -- seq )
over ".private" tail? [
[ words ] dip map
] [
[ [ private-vocab-name words ] dip map ]
[ [ words ] dip map ] 2bi append
] if ; inline
PRIVATE> PRIVATE>
M: string coverage-on M: string coverage-on
[ coverage-on ] change-vocabulary-coverage ; [ coverage-on ] each-word ;
M: string coverage-off ( vocabulary -- ) M: string coverage-off ( vocabulary -- )
[ coverage-off ] change-vocabulary-coverage ; [ coverage-off ] each-word ;
M: word coverage-on ( word -- ) M: word coverage-on ( word -- )
H{ } clone [ "coverage" set-word-prop ] 2keep H{ } clone [ "coverage" set-word-prop ] 2keep
'[ '[
\ coverage new [ _ set-at ] 2keep \ coverage new [ _ set-at ] 2keep
'[ _ t >>executed? drop ] [ ] surround '[ _ t >>executed? drop ] prepend
] deep-annotate ; ] deep-annotate ;
M: word coverage-off ( word -- ) M: word coverage-off ( word -- )
@ -46,7 +54,7 @@ M: word coverage-off ( word -- )
GENERIC: toggle-coverage ( object -- ) GENERIC: toggle-coverage ( object -- )
M: string toggle-coverage M: string toggle-coverage
[ toggle-coverage ] change-vocabulary-coverage ; [ toggle-coverage ] each-word ;
M: word toggle-coverage M: word toggle-coverage
dup "coverage" word-prop [ dup "coverage" word-prop [
@ -76,3 +84,22 @@ M: word coverage.
[ name>> ":" append print ] [ name>> ":" append print ]
[ [ bl bl bl bl . ] each ] bi* [ [ bl bl bl bl . ] each ] bi*
] if-empty ; ] if-empty ;
GENERIC: count-callables ( object -- n )
M: string count-callables
[ count-callables ] map-word sum ;
M: word count-callables
def>> [ callable? ] deep-filter length ;
GENERIC: %coverage ( object -- x )
: calculate-%coverage ( object quot -- x )
[ count-callables ] bi [ swap - ] keep /f ; inline
M: string %coverage
[ coverage values concat length ] calculate-%coverage ;
M: word %coverage
[ coverage length ] calculate-%coverage ;