From 43a7c9a3d87c8723106c67bd7e7c124e39c1f851 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 27 May 2009 19:36:52 -0500
Subject: [PATCH] tools.annotations: work better on generic words

---
 .../tools/annotations/annotations-docs.factor |  5 ---
 .../annotations/annotations-tests.factor      |  3 ++
 basis/tools/annotations/annotations.factor    | 35 ++++++++-----------
 3 files changed, 18 insertions(+), 25 deletions(-)

diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor
index 005f5f7af8..8d73d85fb5 100644
--- a/basis/tools/annotations/annotations-docs.factor
+++ b/basis/tools/annotations/annotations-docs.factor
@@ -39,11 +39,6 @@ HELP: breakpoint-if
 { $values { "quot" { $quotation "( -- ? )" } } { "word" word } }
 { $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ;
 
-HELP: annotate-methods
-{ $values
-     { "word" word } { "quot" quotation } }
-{ $description "Annotates the word -- for generic words, all its methods -- with the quotation." } ;
-
 HELP: reset
 { $values
      { "word" word } }
diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor
index bbd2ac2ca8..c312b54edb 100644
--- a/basis/tools/annotations/annotations-tests.factor
+++ b/basis/tools/annotations/annotations-tests.factor
@@ -39,6 +39,9 @@ M: object another-generic ;
 
 [ "" ] [ [ 3 another-generic drop ] with-string-writer ] unit-test
 
+! reset should do the right thing for generic words
+[ ] [ \ another-generic watch ] unit-test
+
 GENERIC: blah-generic ( a -- b )
 
 M: string blah-generic ;
diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor
index 3cb74fb00b..3aac371a6a 100644
--- a/basis/tools/annotations/annotations.factor
+++ b/basis/tools/annotations/annotations.factor
@@ -9,8 +9,7 @@ IN: tools.annotations
 GENERIC: reset ( word -- )
 
 M: generic reset
-    [ call-next-method ]
-    [ subwords [ reset ] each ] bi ;
+    subwords [ reset ] each ;
 
 M: word reset
     dup "unannotated-def" word-prop [
@@ -22,6 +21,8 @@ M: word reset
 
 ERROR: cannot-annotate-twice word ;
 
+M: cannot-annotate-twice summary drop "Cannot annotate a word twice" ;
+
 <PRIVATE
 
 : check-annotate-twice ( word -- word )
@@ -29,17 +30,19 @@ ERROR: cannot-annotate-twice word ;
         cannot-annotate-twice
     ] when ;
 
-: save-unannotated-def ( word -- )
-    dup def>> "unannotated-def" set-word-prop ;
-
-: (annotate) ( word quot -- )
-    [ dup def>> ] dip call( old -- new ) define ;
-
 PRIVATE>
 
-: annotate ( word quot -- )
+GENERIC# annotate 1 ( word quot -- )
+
+M: generic annotate
+    [ "methods" word-prop values ] dip '[ _ annotate ] each ;
+
+M: word annotate
     [ check-annotate-twice ] dip
-    [ over save-unannotated-def (annotate) ] with-compilation-unit ;
+    [
+        [ dup def>> 2dup "unannotated-def" set-word-prop ] dip
+        call( old -- new ) define
+    ] with-compilation-unit ;
 
 <PRIVATE
 
@@ -77,19 +80,11 @@ PRIVATE>
 : watch-vars ( word vars -- )
     dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
 
-GENERIC# annotate-methods 1 ( word quot -- )
-
-M: generic annotate-methods
-    [ "methods" word-prop values ] dip [ annotate ] curry each ;
-
-M: word annotate-methods
-    annotate ;
-
 : breakpoint ( word -- )
-    [ add-breakpoint ] annotate-methods ;
+    [ add-breakpoint ] annotate ;
 
 : breakpoint-if ( word quot -- )
-    '[ [ _ [ [ break ] when ] ] dip 3append ] annotate-methods ;
+    '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ;
 
 SYMBOL: word-timing