tools.annotations: work better on generic words

Slava Pestov 2009-05-27 19:36:52 -05:00
parent caf4b6c8a1
commit 43a7c9a3d8
3 changed files with 18 additions and 25 deletions

View File

@ -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 } }

View File

@ -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 ;

View File

@ -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