tools.annotations: Optionally re-annotate silently, add reset-all

Introduces variable `override-annotations`.  If set to `t`, annotating a word
twice will not throw an error, but reset the word and apply the new annotation.

The new word `reset-all` is provided as convenience to reset all known
annotations.

diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor
index 56636e2417d840aa3679ee3efc587362315fe234..be10cbeb3026206711524b64e5fb8d887e9f5aae 100644 (file)
--- a/basis/tools/annotations/annotations.factor
+++ b/basis/tools/annotations/annotations.factor
@@ -1,11 +1,13 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.units effects fry
-generalizations generic inspector io kernel locals macros math
-namespaces prettyprint quotations sequences sequences.deep
-sequences.generalizations sorting summary tools.time words ;
+USING: accessors arrays assocs combinators.short-circuit compiler.units effects
+generalizations generic inspector io kernel math namespaces prettyprint
+quotations sequences sequences.deep sequences.generalizations sorting summary
+tools.time vocabs words ;
 IN: tools.annotations
 
+SYMBOL: override-annotations?
+
 <PRIVATE
 
 GENERIC: (reset) ( word -- )
@@ -33,7 +35,11 @@ PREDICATE: annotated < word "unannotated-def" word-prop >boolean ;
 <PRIVATE
 
 : check-annotate-twice ( word -- word )
-    dup annotated? [ cannot-annotate-twice ] when ;
+    dup annotated?
+    [ override-annotations? get
+      [ dup reset ]
+      [ cannot-annotate-twice ] if
+    ] when ;
 
 : annotate-generic ( word quot -- )
     [ "methods" word-prop values ] dip each ; inline
@@ -68,6 +74,12 @@ PRIVATE>
 : deep-annotate ( word quot -- )
     [ (deep-annotate) ] with-compilation-unit ;
 
+: reset-all ( -- )
+    all-words [
+        dup { [ annotated? ] [ subwords [ annotated? ] any? ] } 1||
+        [ reset ] [ drop ] if
+    ] each ;
+
 <PRIVATE
 
 :: trace-quot ( word effect quot str -- quot' )