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