steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up tools.annotations a little

db4
Slava Pestov 2008-11-29 00:37:37 -06:00
parent 265e57e21a
commit a0a72f19f4
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/tools/annotations/annotations.factor
View File

@ -26,12 +26,12 @@ M: word reset
] when
[
over dup def>> "unannotated-def" set-word-prop
>r dup def>> r> call define
[ dup def>> ] dip call define
] with-compilation-unit ; inline
: word-inputs ( word -- seq )
stack-effect [
>r datastack r> in>> length tail*
[ datastack ] dip in>> length tail*
] [
datastack
] if* ;
@ -41,34 +41,38 @@ M: word reset
word-inputs stack.
"\\--" print flush ;
: word-outputs ( word -- seq )
stack-effect [
[ datastack ] dip out>> length tail*
] [
datastack
] if* ;
: leaving ( str -- )
"/-- Leaving: " write dup .
stack-effect [
>r datastack r> out>> length tail* stack.
] [
.s
] if* "\\--" print flush ;
word-outputs stack.
"\\--" print flush ;
: (watch) ( word def -- def ) over '[ _ entering @ _ leaving ] ;
: (watch) ( word def -- def )
over '[ _ entering @ _ leaving ] ;
: watch ( word -- )
dup [ (watch) ] annotate ;
: (watch-vars) ( quot word vars -- newquot )
rot
: (watch-vars) ( word vars quot -- newquot )
'[
"--- Entering: " write _ .
"--- Entering: " write _ .
"--- Variable values:" print _ [ dup get ] H{ } map>assoc describe
@
] ;
: watch-vars ( word vars -- )
dupd [ (watch-vars) ] 2curry annotate ;
dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
GENERIC# annotate-methods 1 ( word quot -- )
M: generic annotate-methods
>r "methods" word-prop values r> [ annotate ] curry each ;
[ "methods" word-prop values ] dip [ annotate ] curry each ;
M: word annotate-methods
annotate ;
@ -77,4 +81,4 @@ M: word annotate-methods
[ add-breakpoint ] annotate-methods ;
: breakpoint-if ( word quot -- )
[ [ [ break ] when ] rot 3append ] curry annotate-methods ;
'[ [ _ [ [ break ] when ] ] dip 3append ] annotate-methods ;