From 472fe7fa4bc88eac3438b693106d5ddd9c6e727e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 27 Aug 2011 12:34:05 -0500
Subject: [PATCH] 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.

---
 basis/tools/coverage/coverage.factor | 37 ++++++++++++++++++++++++----
 1 file changed, 32 insertions(+), 5 deletions(-)

diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor
index 062358568e..df46ae634d 100644
--- a/basis/tools/coverage/coverage.factor
+++ b/basis/tools/coverage/coverage.factor
@@ -17,7 +17,7 @@ GENERIC: coverage-off ( object -- )
 : private-vocab-name ( string -- string' )
     ".private" ?tail drop ".private" append ;
 
-: change-vocabulary-coverage ( string quot -- )
+: each-word ( string quot -- )
     over ".private" tail? [
         [ words ] dip each
     ] [
@@ -25,19 +25,27 @@ GENERIC: coverage-off ( object -- )
         [ [ words ] dip each ] 2bi
     ] 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>
 
 M: string coverage-on
-    [ coverage-on ] change-vocabulary-coverage ;
+    [ coverage-on ] each-word ;
 
 M: string coverage-off ( vocabulary -- )
-    [ coverage-off ] change-vocabulary-coverage ;
+    [ coverage-off ] each-word ;
 
 M: word coverage-on ( word -- )
     H{ } clone [ "coverage" set-word-prop ] 2keep
     '[
         \ coverage new [ _ set-at ] 2keep
-        '[ _ t >>executed? drop ] [ ] surround
+        '[ _ t >>executed? drop ] prepend
     ] deep-annotate ;
 
 M: word coverage-off ( word -- )
@@ -46,7 +54,7 @@ M: word coverage-off ( word -- )
 GENERIC: toggle-coverage ( object -- )
 
 M: string toggle-coverage
-    [ toggle-coverage ] change-vocabulary-coverage ;
+    [ toggle-coverage ] each-word ;
 
 M: word toggle-coverage
     dup "coverage" word-prop [
@@ -76,3 +84,22 @@ M: word coverage.
         [ name>> ":" append print ]
         [ [ bl bl bl bl . ] each ] bi*
     ] 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 ;