! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: inspector
-USING: generic hashtables io kernel kernel-internals lists math
-memory namespaces prettyprint sequences strings styles test
-vectors words ;
-
-SYMBOL: inspecting
+USING: generic hashtables io kernel kernel-internals listener
+lists math memory namespaces prettyprint sequences strings
+styles test vectors words ;
GENERIC: sheet ( obj -- sheet )
: sheet-numbers ( sheet -- sheet )
dup first length >vector 1vector swap append ;
+SYMBOL: inspector-slots
+
: format-sheet ( sheet -- list )
sheet-numbers
- dup peek over first [ set ] 2each
+ dup peek inspector-slots set
[ format-column ] map
flip
[ " | " join ] map ;
sheet dup format-sheet swap peek
[ write-object terpri ] 2each ;
+SYMBOL: inspector-stack
+
+: inspecting ( -- obj ) inspector-stack get peek ;
+
+: (inspect) ( obj -- )
+ dup inspector-stack get push
+ dup inspect-banner describe ;
+
+: inspector-help ( -- )
+ "Object inspector." print
+ "inspecting ( -- obj ) push current object" print
+ "go ( n -- ) inspect nth slot" print
+ "up -- return to previous object" print
+ "refs -- inspect references to current object" print
+ "bye -- exit inspector" print ;
+
+: inspector ( obj -- )
+ [
+ inspector-help
+ terpri
+ "inspector " listener-prompt set
+ 10 <vector> inspector-stack set
+ (inspect)
+ listener
+ ] with-scope ;
+
: inspect ( obj -- )
- dup inspecting set dup inspect-banner describe ;
+ #! Start an inspector if its not already running.
+ inspector-stack get [ (inspect) ] [ inspector ] ifte ;
+
+: go ( n -- ) inspector-slots get nth (inspect) ;
+
+: up ( -- ) inspector-stack get >pop> pop (inspect) ;
-: go ( n -- ) get inspect ;
+: refs ( -- ) inspecting references (inspect) ;
set-callstack call ;
: walk-banner ( -- )
- "&s &r show stepper stacks." print
- "&get ( var -- value ) inspects the stepper namestack." print
+ "&s &r show stepper stacks" print
+ "&get ( var -- value ) get stepper variable value" print
"step -- single step over" print
"into -- single step into" print
"continue -- continue execution" print