Inspector cleanups

slava 2006-08-01 22:42:53 +00:00
parent bcf30cf1af
commit a7039a8e0d
2 changed files with 16 additions and 17 deletions

View File

@ -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 =

View File

@ -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) ;