2005-07-06 01:28:45 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2006-09-05 01:29:26 -04:00
|
|
|
IN: tools
|
2006-08-01 18:42:53 -04:00
|
|
|
USING: arrays generic io kernel listener math memory namespaces
|
2005-09-25 21:56:48 -04:00
|
|
|
prettyprint sequences words ;
|
2005-09-25 21:54:25 -04:00
|
|
|
|
|
|
|
SYMBOL: inspector-slots
|
|
|
|
|
|
|
|
: sheet-numbers ( sheet -- sheet )
|
2006-08-01 18:42:53 -04:00
|
|
|
dup [ peek ] map inspector-slots set
|
|
|
|
dup length [ 1+ add* ] 2map ;
|
2005-07-24 23:09:43 -04:00
|
|
|
|
2005-08-23 22:27:05 -04:00
|
|
|
SYMBOL: inspector-stack
|
|
|
|
|
2006-10-04 00:40:10 -04:00
|
|
|
: me ( -- obj ) inspector-stack get peek ;
|
2005-08-23 22:27:05 -04:00
|
|
|
|
|
|
|
: (inspect) ( obj -- )
|
|
|
|
dup inspector-stack get push
|
2005-10-03 20:54:05 -04:00
|
|
|
dup summary print
|
2006-02-03 13:20:22 -05:00
|
|
|
sheet sheet-numbers sheet. ;
|
2005-08-23 22:27:05 -04:00
|
|
|
|
2006-08-24 23:06:07 -04:00
|
|
|
: go ( n -- ) 1- inspector-slots get nth (inspect) ;
|
|
|
|
|
|
|
|
: up ( -- ) inspector-stack get dup pop* pop (inspect) ;
|
|
|
|
|
2005-08-23 22:27:05 -04:00
|
|
|
: inspector-help ( -- )
|
|
|
|
"Object inspector." print
|
2006-10-04 00:40:10 -04:00
|
|
|
"up -- return to previous object" [ up ] print-quot
|
|
|
|
"me ( -- obj ) push this object" [ me ] print-quot
|
2006-08-25 20:52:13 -04:00
|
|
|
"go ( n -- ) inspect nth slot" print
|
|
|
|
terpri ;
|
2005-08-23 22:27:05 -04:00
|
|
|
|
|
|
|
: inspector ( obj -- )
|
2006-08-24 23:06:07 -04:00
|
|
|
inspector-help
|
|
|
|
V{ } clone inspector-stack set
|
|
|
|
(inspect) ;
|
2005-08-23 22:27:05 -04:00
|
|
|
|
2005-07-06 01:28:45 -04:00
|
|
|
: inspect ( obj -- )
|
2005-09-24 15:21:17 -04:00
|
|
|
inspector-stack get [ (inspect) ] [ inspector ] if ;
|