factor/library/tools/annotations.factor

45 lines
1.3 KiB
Factor
Raw Normal View History

2005-03-10 17:57:22 -05:00
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: words
2005-08-24 21:52:10 -04:00
USING: interpreter io kernel lists math namespaces prettyprint
sequences strings test ;
2005-03-10 17:57:22 -05:00
! The annotation words let you flag a word for either tracing
! or single-stepping. Note that currently, words referring to
2005-08-24 21:52:10 -04:00
! annotated words cannot be compiled.
2005-04-14 19:37:13 -04:00
: annotate ( word quot -- | quot: word def -- def )
2005-08-23 15:50:32 -04:00
over >r >r dup word-def r> call r> swap define-compound ;
2005-04-01 12:42:14 -05:00
inline
2005-03-10 17:57:22 -05:00
2005-04-14 19:37:13 -04:00
: (watch) ( word def -- def )
2005-08-08 15:21:14 -04:00
[
2005-08-24 21:52:10 -04:00
"===> Entering: " pick word-name append ,
[ print .s ] %
2005-08-08 15:21:14 -04:00
%
2005-08-24 21:52:10 -04:00
"===> Leaving: " swap word-name append ,
[ print .s ] %
2005-08-08 15:21:14 -04:00
] make-list ;
2005-03-10 17:57:22 -05:00
: watch ( word -- )
#! Cause a message to be printed out when the word is
2005-04-14 19:37:13 -04:00
#! executed.
2005-03-10 17:57:22 -05:00
[ (watch) ] annotate ;
: break ( word -- )
#! Cause the word to start the code walker when executed.
[ nip [ walk ] cons ] annotate ;
2005-08-24 21:52:10 -04:00
: +@ ( n var -- ) dup get [ swap >r + r> ] when* set ;
: with-profile ( quot word -- )
millis >r >r call r> millis r> - swap global [ +@ ] bind ;
inline
: (profile) ( word def -- def )
[ , literalize , \ with-profile , ] make-list ;
: profile ( word -- )
#! When the word is called, time it, and add the time to
#! the value in a global variable named by the word.
[ (profile) ] annotate ;