factor/library/tools/walker.factor

69 lines
1.7 KiB
Factor
Raw Normal View History

2005-03-07 22:11:36 -05:00
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: interpreter
USING: errors kernel listener lists math namespaces prettyprint
sequences io strings vectors words ;
2005-03-07 22:11:36 -05:00
! The single-stepper simulates Factor in Factor to allow
! single-stepping through the execution of a quotation. It can
! transfer the continuation to and from the primary interpreter.
2005-03-07 22:11:36 -05:00
: &s
#! Print stepper data stack.
meta-d get stack. ;
2005-03-07 22:11:36 -05:00
: &r
#! Print stepper call stack, as well as the currently
#! executing quotation.
meta-cf get unparse-short.
meta-executing get . meta-r get stack. ;
2005-03-07 22:11:36 -05:00
: &get ( var -- value )
2005-03-10 17:57:22 -05:00
#! Get stepper variable value.
2005-03-07 22:11:36 -05:00
meta-n get (get) ;
: report ( -- ) meta-cf get . ;
2005-03-07 22:11:36 -05:00
: step
2005-03-10 17:57:22 -05:00
#! Step over current word.
next do-1 report ;
2005-03-07 22:11:36 -05:00
: into
#! Step into current word.
next do report ;
: continue
#! Continue executing the single-stepped continuation in the
#! primary interpreter.
meta-d get set-datastack
meta-c get set-catchstack
meta-cf get
meta-r get
meta-n get set-namestack
set-callstack call ;
2005-03-07 22:11:36 -05:00
: walk-banner ( -- )
2005-08-21 01:17:37 -04:00
"&s &r show stepper stacks." print
"&get ( var -- value ) inspects the stepper namestack." print
"step -- single step over" print
"into -- single step into" print
"continue -- continue execution" print
"bye -- exit single-stepper" print
2005-03-07 22:11:36 -05:00
report ;
: walk-listener walk-banner "walk " listener-prompt set listener ;
2005-03-10 17:57:22 -05:00
: init-walk ( quot callstack namestack -- )
init-interpreter
meta-n set
meta-r set
meta-cf set
datastack meta-d set ;
2005-03-07 22:11:36 -05:00
: walk ( quot -- )
#! Single-step through execution of a quotation.
callstack namestack [
init-walk
2005-03-10 17:57:22 -05:00
walk-listener
] with-scope ;