improved inspector with slot links
parent
b0ecd948ce
commit
a7e713764f
|
@ -2,8 +2,8 @@
|
||||||
! 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: generic hashtables io kernel kernel-internals lists math
|
USING: generic hashtables io kernel kernel-internals lists math
|
||||||
memory namespaces prettyprint sequences strings test unparser
|
memory namespaces prettyprint sequences strings styles test
|
||||||
vectors words ;
|
unparser vectors words ;
|
||||||
|
|
||||||
SYMBOL: inspecting
|
SYMBOL: inspecting
|
||||||
|
|
||||||
|
@ -16,11 +16,11 @@ M: object sheet ( obj -- sheet )
|
||||||
|
|
||||||
PREDICATE: list nonvoid cons? ;
|
PREDICATE: list nonvoid cons? ;
|
||||||
|
|
||||||
M: nonvoid sheet >list unit ;
|
M: nonvoid sheet unit ;
|
||||||
|
|
||||||
M: vector sheet >list unit ;
|
M: vector sheet unit ;
|
||||||
|
|
||||||
M: array sheet >list unit ;
|
M: array sheet unit ;
|
||||||
|
|
||||||
M: hashtable sheet hash>alist unzip 2list ;
|
M: hashtable sheet hash>alist unzip 2list ;
|
||||||
|
|
||||||
|
@ -29,8 +29,8 @@ M: hashtable sheet hash>alist unzip 2list ;
|
||||||
[ [ length ] map 0 [ max ] reduce ] keep
|
[ [ length ] map 0 [ max ] reduce ] keep
|
||||||
[ swap CHAR: \s pad-right ] map-with ;
|
[ swap CHAR: \s pad-right ] map-with ;
|
||||||
|
|
||||||
: describe ( obj -- list )
|
: format-sheet ( sheet -- list )
|
||||||
sheet dup first length count swons
|
dup first length count swons
|
||||||
dup peek over first [ set ] 2each
|
dup peek over first [ set ] 2each
|
||||||
[ column ] map
|
[ column ] map
|
||||||
seq-transpose
|
seq-transpose
|
||||||
|
@ -68,6 +68,10 @@ M: object extra-banner ( obj -- ) drop ;
|
||||||
"It takes up " write dup size unparse write " bytes of memory." print
|
"It takes up " write dup size unparse write " bytes of memory." print
|
||||||
extra-banner ;
|
extra-banner ;
|
||||||
|
|
||||||
|
: describe ( obj -- )
|
||||||
|
sheet dup format-sheet
|
||||||
|
swap peek [ presented swons unit ] map
|
||||||
|
[ format terpri ] 2each ;
|
||||||
|
|
||||||
: inspect ( obj -- )
|
: inspect ( obj -- )
|
||||||
dup inspecting set
|
dup inspecting set dup inspect-banner describe ;
|
||||||
dup inspect-banner describe [ print ] each ;
|
|
||||||
|
|
|
@ -22,8 +22,8 @@ TUPLE: pack align fill vector ;
|
||||||
: pref-dims ( gadget -- list )
|
: pref-dims ( gadget -- list )
|
||||||
gadget-children [ pref-dim ] map ;
|
gadget-children [ pref-dim ] map ;
|
||||||
|
|
||||||
: orient ( gadget list1 list2 -- list )
|
: orient ( gadget seq1 seq2 -- seq )
|
||||||
zip >r pack-vector r> [ uncons rot set-axis ] map-with ;
|
>r >r pack-vector r> r> [ pick set-axis ] 2map nip ;
|
||||||
|
|
||||||
: packed-dim-2 ( gadget sizes -- list )
|
: packed-dim-2 ( gadget sizes -- list )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue