83 lines
2.0 KiB
Factor
Executable File
83 lines
2.0 KiB
Factor
Executable File
! Copyright (C) 2005, 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors kernel words parser io summary quotations
|
|
sequences prettyprint continuations effects definitions
|
|
compiler.units namespaces assocs tools.walker generic
|
|
inspector ;
|
|
IN: tools.annotations
|
|
|
|
GENERIC: reset ( word -- )
|
|
|
|
M: generic reset
|
|
[ call-next-method ]
|
|
[ subwords [ reset ] each ] bi ;
|
|
|
|
M: word reset
|
|
dup "unannotated-def" word-prop [
|
|
[
|
|
dup dup "unannotated-def" word-prop define
|
|
] with-compilation-unit
|
|
f "unannotated-def" set-word-prop
|
|
] [ drop ] if ;
|
|
|
|
: annotate ( word quot -- )
|
|
over "unannotated-def" word-prop [
|
|
"Cannot annotate a word twice" throw
|
|
] when
|
|
[
|
|
over dup def>> "unannotated-def" set-word-prop
|
|
>r dup def>> r> call define
|
|
] with-compilation-unit ; inline
|
|
|
|
: word-inputs ( word -- seq )
|
|
stack-effect [
|
|
>r datastack r> in>> length tail*
|
|
] [
|
|
datastack
|
|
] if* ;
|
|
|
|
: entering ( str -- )
|
|
"/-- Entering: " write dup .
|
|
word-inputs stack.
|
|
"\\--" print flush ;
|
|
|
|
: leaving ( str -- )
|
|
"/-- Leaving: " write dup .
|
|
stack-effect [
|
|
>r datastack r> out>> length tail* stack.
|
|
] [
|
|
.s
|
|
] if* "\\--" print flush ;
|
|
|
|
: (watch) ( word def -- def )
|
|
over [ entering ] curry
|
|
rot [ leaving ] curry
|
|
swapd 3append ;
|
|
|
|
: watch ( word -- )
|
|
dup [ (watch) ] annotate ;
|
|
|
|
: (watch-vars) ( quot word vars -- newquot )
|
|
[
|
|
"--- Entering: " write swap .
|
|
"--- Variable values:" print
|
|
[ dup get ] H{ } map>assoc describe
|
|
] 2curry prepose ;
|
|
|
|
: watch-vars ( word vars -- )
|
|
dupd [ (watch-vars) ] 2curry annotate ;
|
|
|
|
GENERIC# annotate-methods 1 ( word quot -- )
|
|
|
|
M: generic annotate-methods
|
|
>r "methods" word-prop values r> [ annotate ] curry each ;
|
|
|
|
M: word annotate-methods
|
|
annotate ;
|
|
|
|
: breakpoint ( word -- )
|
|
[ add-breakpoint ] annotate-methods ;
|
|
|
|
: breakpoint-if ( word quot -- )
|
|
[ [ [ break ] when ] rot 3append ] curry annotate-methods ;
|