Make watch and other annotations work on method-specs. { world graft* } watch

basis/tools/annotations/annotations-tests.factor

@@ -38,3 +38,11 @@ M: object another-generic ;
 [ ] [ \ another-generic reset ] unit-test
 
 [ "" ] [ [ 3 another-generic drop ] with-string-writer ] unit-test
+
+GENERIC: blah-generic ( a -- b )
+
+M: string blah-generic ;
+
+{ string blah-generic } watch
+
+[ ] [ "hi" blah-generic ] unit-test

basis/tools/annotations/annotations.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math sorting words parser io summary
 quotations sequences prettyprint continuations effects
@@ -20,16 +20,34 @@ M: word reset
         f "unannotated-def" set-word-prop
     ] [ drop ] if ;
 
+M: method-spec reset
+    first2 method reset ;
+
 ERROR: cannot-annotate-twice word ;
 
+<PRIVATE
+
+: check-annotate-twice ( word -- word )
+    dup "unannotated-def" word-prop [
+        cannot-annotate-twice
+    ] when ;
+
+: method-spec>word ( obj -- word )
+    dup method-spec? [ first2 method ] when ;
+
+: save-unannotated-def ( word -- )
+    dup def>> "unannotated-def" set-word-prop ;
+
+: (annotate) ( word quot -- )
+    [ dup def>> ] dip call define ; inline
+
+PRIVATE>
+
 : annotate ( word quot -- )
-    over "unannotated-def" word-prop [
+    [ method-spec>word check-annotate-twice ] dip
-        over cannot-annotate-twice
+    [ over save-unannotated-def (annotate) ] with-compilation-unit ; inline
-    ] when
+
-    [
+<PRIVATE
-        over dup def>> "unannotated-def" set-word-prop
-        [ dup def>> ] dip call define
-    ] with-compilation-unit ; inline
 
 : word-inputs ( word -- seq )
     stack-effect [
@@ -58,8 +76,12 @@ ERROR: cannot-annotate-twice word ;
 : (watch) ( word def -- def )
     over '[ _ entering @ _ leaving ] ;
 
+PRIVATE>
+
 : watch ( word -- )
-    dup [ (watch) ] annotate ;
+    dup '[ [ _ ] dip (watch) ] annotate ;
+
+<PRIVATE
 
 : (watch-vars) ( word vars quot -- newquot )
    '[
@@ -71,6 +93,8 @@ ERROR: cannot-annotate-twice word ;
 : watch-vars ( word vars -- )
     dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
 
+PRIVATE>
+
 GENERIC# annotate-methods 1 ( word quot -- )
 
 M: generic annotate-methods
@@ -79,6 +103,9 @@ M: generic annotate-methods
 M: word annotate-methods
     annotate ;
 
+M: method-spec annotate-methods
+    annotate ;
+
 : breakpoint ( word -- )
     [ add-breakpoint ] annotate-methods ;
 
@@ -92,9 +119,13 @@ word-timing [ H{ } clone ] initialize
 : reset-word-timing ( -- )
     word-timing get clear-assoc ;
 
+<PRIVATE
+
 : (add-timing) ( def word -- def' )
     '[ _ benchmark _ word-timing get at+ ] ;
 
+PRIVATE>
+
 : add-timing ( word -- )
     dup '[ _ (add-timing) ] annotate ;
 

core/generic/generic.factor

@@ -83,6 +83,9 @@ TUPLE: check-method class generic ;
 PREDICATE: method-body < word
     "method-generic" word-prop >boolean ;
 
+M: method-spec stack-effect
+    first2 method stack-effect ;
+
 M: method-body stack-effect
     "method-generic" word-prop stack-effect ;