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

tools.annotations: redo 'watch' so that it doesn't call 'datastack' anymore, instead use macros to capture stack values. This works better with compiler optimizations

db4
Slava Pestov 2009-07-03 22:32:30 -05:00
parent a3c3445643
commit f53efa88c6
2 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/tools/annotations/annotations-tests.factor
View File

@ -49,3 +49,14 @@ M: string blah-generic ;
[ ] [ M\ string blah-generic watch ] unit-test [ ] [ M\ string blah-generic watch ] unit-test
[ "hi" ] [ "hi" blah-generic ] unit-test [ "hi" ] [ "hi" blah-generic ] unit-test
! See how well watch interacts with optimizations.
GENERIC: my-generic ( a -- b )
M: object my-generic ;
\ my-generic watch
: some-code ( -- )
f my-generic drop ;
[ ] [ some-code ] unit-test

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

@ -3,7 +3,8 @@
USING: accessors kernel math sorting words parser io summary USING: accessors kernel math sorting words parser io summary
quotations sequences prettyprint continuations effects quotations sequences prettyprint continuations effects
definitions compiler.units namespaces assocs tools.walker definitions compiler.units namespaces assocs tools.walker
tools.time generic inspector fry tools.continuations ; tools.time generic inspector fry tools.continuations
locals generalizations macros ;
IN: tools.annotations IN: tools.annotations
GENERIC: reset ( word -- ) GENERIC: reset ( word -- )
@ -46,17 +47,20 @@ M: word annotate
<PRIVATE <PRIVATE
: stack-values ( names -- alist ) :: trace-quot ( word effect quot str -- quot' )
[ datastack ] dip [ nip ] [ length tail* ] 2bi zip ; effect quot call :> values
values length :> n
[
"--- " write str write bl word .
n ndup n narray values swap zip simple-table.
flush
] ; inline
: trace-message ( word quot str -- ) MACRO: entering ( word -- quot )
"--- " write write bl over . dup stack-effect [ in>> ] "Entering" trace-quot ;
[ stack-effect ] dip '[ @ stack-values ] [ f ] if*
[ simple-table. ] unless-empty flush ; inline
: entering ( str -- ) [ in>> ] "Entering" trace-message ; MACRO: leaving ( word -- quot )
dup stack-effect [ out>> ] "Leaving" trace-quot ;
: leaving ( str -- ) [ out>> ] "Leaving" trace-message ;
: (watch) ( word def -- def ) : (watch) ( word def -- def )
over '[ _ entering @ _ leaving ] ; over '[ _ entering @ _ leaving ] ;