139 lines
3.1 KiB
Factor
139 lines
3.1 KiB
Factor
! Copyright (C) 2004, 2007 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: arrays assocs classes combinators combinators.private
|
|
continuations continuations.private generic hashtables io kernel
|
|
kernel.private math namespaces namespaces.private prettyprint
|
|
quotations sequences splitting strings threads vectors words ;
|
|
IN: tools.interpreter
|
|
|
|
SYMBOL: interpreter
|
|
|
|
SYMBOL: break-hook
|
|
|
|
: break ( -- )
|
|
continuation callstack
|
|
over set-continuation-call
|
|
walker-hook [ continue-with ] [ break-hook get call ] if* ;
|
|
|
|
: with-interpreter-datastack ( quot -- )
|
|
interpreter get continuation-data
|
|
swap with-datastack
|
|
interpreter get set-continuation-data ; inline
|
|
|
|
GENERIC: restore ( obj -- )
|
|
|
|
M: continuation restore
|
|
clone interpreter set ;
|
|
|
|
M: pair restore
|
|
first2 clone interpreter set
|
|
[ nip f ] curry with-interpreter-datastack ;
|
|
|
|
M: f restore
|
|
drop interpreter off ;
|
|
|
|
: (step-into-call) \ break add* call ;
|
|
|
|
: (step-into-if) ? (step-into-call) ;
|
|
|
|
: (step-into-dispatch)
|
|
nth (step-into-call) ;
|
|
|
|
: (step-into-execute) ( word -- )
|
|
dup "step-into" word-prop [
|
|
call
|
|
] [
|
|
dup compound? [
|
|
word-def (step-into-call)
|
|
] [
|
|
execute break
|
|
] if
|
|
] ?if ;
|
|
|
|
: (step-into-continuation)
|
|
continuation callstack over set-continuation-call break ;
|
|
|
|
{
|
|
{ call [ (step-into-call) ] }
|
|
{ (throw) [ (step-into-call) ] }
|
|
{ execute [ (step-into-execute) ] }
|
|
{ if [ (step-into-if) ] }
|
|
{ dispatch [ (step-into-dispatch) ] }
|
|
{ continuation [ (step-into-continuation) ] }
|
|
} [ "step-into" set-word-prop ] assoc-each
|
|
|
|
{
|
|
>n ndrop >c c>
|
|
continue continue-with
|
|
(continue-with) stop break
|
|
} [
|
|
dup [ execute break ] curry
|
|
"step-into" set-word-prop
|
|
] each
|
|
|
|
! Time travel
|
|
SYMBOL: history
|
|
|
|
: save-interpreter ( -- )
|
|
history get [ interpreter get clone swap push ] when* ;
|
|
|
|
: restore-interpreter ( interp -- )
|
|
clone interpreter set ;
|
|
|
|
: step-back ( -- )
|
|
history get dup empty?
|
|
[ drop ] [ pop restore-interpreter ] if ;
|
|
|
|
: (continue) ( continuation -- )
|
|
>continuation<
|
|
set-catchstack
|
|
set-namestack
|
|
set-retainstack
|
|
>r set-datastack r>
|
|
set-callstack ;
|
|
|
|
! Stepping
|
|
: step-all ( -- )
|
|
[ interpreter get (continue) ] in-thread ;
|
|
|
|
: change-innermost-frame ( quot -- )
|
|
interpreter get continuation-call clone
|
|
[
|
|
dup innermost-frame-scan 1+
|
|
swap innermost-frame-quot
|
|
rot call
|
|
] keep
|
|
[ set-innermost-frame-quot ] keep
|
|
interpreter get set-continuation-call ; inline
|
|
|
|
: (step) ( quot -- )
|
|
save-interpreter
|
|
change-innermost-frame
|
|
[ set-walker-hook interpreter get (continue) ] callcc1
|
|
restore ;
|
|
|
|
: step ( n -- )
|
|
[
|
|
2dup nth \ break = [
|
|
nip
|
|
] [
|
|
>r 1+ r> cut [ break ] swap 3append
|
|
] if
|
|
] (step) ;
|
|
|
|
: step-out ( -- )
|
|
[ nip \ break add ] (step) ;
|
|
|
|
GENERIC: (step-into) ( obj -- )
|
|
|
|
M: word (step-into) (step-into-execute) ;
|
|
M: wrapper (step-into) wrapped break ;
|
|
M: object (step-into) break ;
|
|
|
|
: step-into ( -- )
|
|
[
|
|
cut [
|
|
swap % unclip literalize , \ (step-into) , %
|
|
] [ ] make
|
|
] (step) ;
|