Inspector cleanups
parent
bcf30cf1af
commit
a7039a8e0d
|
@ -8,30 +8,32 @@ words ;
|
||||||
GENERIC: sheet ( obj -- sheet )
|
GENERIC: sheet ( obj -- sheet )
|
||||||
|
|
||||||
: slot-sheet ( obj -- sheet )
|
: slot-sheet ( obj -- sheet )
|
||||||
dup class "slots" word-prop
|
dup class "slots" word-prop [
|
||||||
dup [ third ] map -rot
|
dup third -rot first slot 2array
|
||||||
[ first slot ] map-with
|
] map-with ;
|
||||||
2array ;
|
|
||||||
|
|
||||||
M: object sheet ( obj -- sheet ) slot-sheet ;
|
M: object sheet ( obj -- sheet ) slot-sheet ;
|
||||||
|
|
||||||
|
M: tuple sheet ( tuple -- sheet )
|
||||||
|
dup slot-sheet swap delegate [ 1 tail ] unless ;
|
||||||
|
|
||||||
M: sequence summary
|
M: sequence summary
|
||||||
[ dup length # " element " % class word-name % ] "" make ;
|
[ dup length # " element " % class word-name % ] "" make ;
|
||||||
|
|
||||||
M: quotation sheet 1array ;
|
: sequence-sheet [ 1array ] map ;
|
||||||
|
|
||||||
M: vector sheet 1array ;
|
M: quotation sheet sequence-sheet ;
|
||||||
|
M: vector sheet sequence-sheet ;
|
||||||
M: array sheet 1array ;
|
M: array sheet sequence-sheet ;
|
||||||
|
|
||||||
M: hashtable summary
|
M: hashtable summary
|
||||||
"a hashtable storing " swap hash-size number>string
|
"a hashtable storing " swap hash-size number>string
|
||||||
" keys" append3 ;
|
" keys" append3 ;
|
||||||
|
|
||||||
M: hashtable sheet hash>alist flip ;
|
M: hashtable sheet hash>alist ;
|
||||||
|
|
||||||
: sheet. ( sheet -- )
|
: sheet. ( sheet -- )
|
||||||
flip dup empty? [
|
dup empty? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
dup first length 1 =
|
dup first length 1 =
|
||||||
|
|
|
@ -1,16 +1,14 @@
|
||||||
! Copyright (C) 2005 Slava Pestov.
|
! Copyright (C) 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: inspector
|
IN: inspector
|
||||||
USING: arrays generic io kernel listener memory namespaces
|
USING: arrays generic io kernel listener math memory namespaces
|
||||||
prettyprint sequences words ;
|
prettyprint sequences words ;
|
||||||
|
|
||||||
SYMBOL: inspector-slots
|
SYMBOL: inspector-slots
|
||||||
|
|
||||||
: sheet-numbers ( sheet -- sheet )
|
: sheet-numbers ( sheet -- sheet )
|
||||||
dup empty? [
|
dup [ peek ] map inspector-slots set
|
||||||
dup first length >array 1array swap append
|
dup length [ 1+ add* ] 2map ;
|
||||||
dup peek inspector-slots set
|
|
||||||
] unless ;
|
|
||||||
|
|
||||||
SYMBOL: inspector-stack
|
SYMBOL: inspector-stack
|
||||||
|
|
||||||
|
@ -40,9 +38,8 @@ SYMBOL: inspector-stack
|
||||||
] listener ;
|
] listener ;
|
||||||
|
|
||||||
: inspect ( obj -- )
|
: inspect ( obj -- )
|
||||||
#! Start an inspector if its not already running.
|
|
||||||
inspector-stack get [ (inspect) ] [ inspector ] if ;
|
inspector-stack get [ (inspect) ] [ inspector ] if ;
|
||||||
|
|
||||||
: go ( n -- ) inspector-slots get nth (inspect) ;
|
: go ( n -- ) 1- inspector-slots get nth (inspect) ;
|
||||||
|
|
||||||
: up ( -- ) inspector-stack get dup pop* pop (inspect) ;
|
: up ( -- ) inspector-stack get dup pop* pop (inspect) ;
|
||||||
|
|
Loading…
Reference in New Issue