tools.annotations: work better on generic words
parent
caf4b6c8a1
commit
43a7c9a3d8
|
@ -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 } }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue