108 lines
2.5 KiB
Factor
108 lines
2.5 KiB
Factor
! Copyright (C) 2011 Doug Coleman.
|
|
! 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 arrays words.symbol
|
|
combinators.short-circuit ;
|
|
IN: tools.coverage
|
|
|
|
TUPLE: coverage < identity-tuple executed? ;
|
|
|
|
C: <coverage> coverage
|
|
|
|
GENERIC: coverage-on ( object -- )
|
|
|
|
GENERIC: coverage-off ( object -- )
|
|
|
|
<PRIVATE
|
|
|
|
: private-vocab-name ( string -- string' )
|
|
".private" ?tail drop ".private" append ;
|
|
|
|
: coverage-words ( string -- words )
|
|
words [ { [ primitive? not ] [ symbol? not ] } 1&& ] filter ;
|
|
|
|
PRIVATE>
|
|
|
|
: each-word ( string quot -- )
|
|
over ".private" tail? [
|
|
[ coverage-words ] dip each
|
|
] [
|
|
[ [ private-vocab-name coverage-words ] dip each ]
|
|
[ [ coverage-words ] dip each ] 2bi
|
|
] if ; inline
|
|
|
|
: map-words ( string quot -- sequence )
|
|
over ".private" tail? [
|
|
[ coverage-words ] dip map
|
|
] [
|
|
[ [ private-vocab-name coverage-words ] dip map ]
|
|
[ [ coverage-words ] dip map ] 2bi append
|
|
] if ; inline
|
|
|
|
M: string coverage-on
|
|
[ coverage-on ] each-word ;
|
|
|
|
M: string coverage-off ( vocabulary -- )
|
|
[ coverage-off ] each-word ;
|
|
|
|
M: word coverage-on ( word -- )
|
|
H{ } clone [ "coverage" set-word-prop ] 2keep
|
|
'[
|
|
\ coverage new [ _ set-at ] 2keep
|
|
'[ _ t >>executed? drop ] prepend
|
|
] deep-annotate ;
|
|
|
|
M: word coverage-off ( word -- )
|
|
[ reset ] [ f "coverage" set-word-prop ] bi ;
|
|
|
|
GENERIC: toggle-coverage ( object -- )
|
|
|
|
M: string toggle-coverage
|
|
[ toggle-coverage ] each-word ;
|
|
|
|
M: word toggle-coverage
|
|
dup "coverage" word-prop [
|
|
coverage-off
|
|
] [
|
|
coverage-on
|
|
] if ;
|
|
|
|
GENERIC: coverage ( object -- seq )
|
|
|
|
M: string coverage
|
|
[ dup coverage 2array ] map-words ;
|
|
|
|
M: word coverage ( word -- seq )
|
|
"coverage" word-prop >alist
|
|
[ drop executed?>> not ] assoc-filter values ;
|
|
|
|
GENERIC: coverage. ( object -- )
|
|
|
|
M: string coverage.
|
|
[ coverage. ] each-word ;
|
|
|
|
M: word coverage.
|
|
dup coverage [
|
|
drop
|
|
] [
|
|
[ name>> ":" append print ]
|
|
[ [ " " write . ] each ] bi*
|
|
] if-empty ;
|
|
|
|
<PRIVATE
|
|
|
|
GENERIC: count-callables ( object -- n )
|
|
|
|
M: string count-callables
|
|
[ count-callables ] map-words sum ;
|
|
|
|
M: word count-callables
|
|
"coverage" word-prop assoc-size ;
|
|
|
|
PRIVATE>
|
|
|
|
: %coverage ( string -- x )
|
|
[ coverage values concat length ]
|
|
[ count-callables ] bi [ swap - ] keep /f ; inline
|