2006-05-20 16:42:33 -04:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-09-25 21:56:48 -04:00
|
|
|
IN: inspector
|
2006-06-05 23:26:44 -04:00
|
|
|
USING: arrays generic hashtables io kernel kernel-internals
|
2006-05-25 23:25:00 -04:00
|
|
|
math namespaces prettyprint sequences strings styles vectors
|
|
|
|
words ;
|
2005-09-25 21:56:48 -04:00
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
GENERIC: summary ( object -- string )
|
|
|
|
|
|
|
|
: sign-string ( n -- string )
|
|
|
|
0 > "a positive " "a negative " ? ;
|
|
|
|
|
|
|
|
M: integer summary
|
2006-04-14 03:53:45 -04:00
|
|
|
dup zero? [
|
|
|
|
"a " "zero "
|
|
|
|
] [
|
|
|
|
dup sign-string over 2 mod zero? "even " "odd " ?
|
|
|
|
] if rot class word-name append3 ;
|
2005-10-03 20:54:05 -04:00
|
|
|
|
|
|
|
M: real summary
|
|
|
|
dup sign-string swap class word-name append ;
|
|
|
|
|
|
|
|
M: complex summary
|
|
|
|
"a complex number in the "
|
2005-10-29 23:25:38 -04:00
|
|
|
swap quadrant { "first" "second" "fourth" "third" } nth
|
2005-10-03 20:54:05 -04:00
|
|
|
" quadrant" append3 ;
|
|
|
|
|
2005-09-25 21:56:48 -04:00
|
|
|
GENERIC: sheet ( obj -- sheet )
|
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
M: object summary
|
|
|
|
"an instance of the " swap class word-name " class" append3 ;
|
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
: slot-sheet ( obj -- sheet )
|
2005-09-25 21:56:48 -04:00
|
|
|
dup class "slots" word-prop
|
2006-05-02 03:05:57 -04:00
|
|
|
dup [ third ] map -rot
|
2005-09-25 21:56:48 -04:00
|
|
|
[ first slot ] map-with
|
|
|
|
2array ;
|
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
M: object sheet ( obj -- sheet ) slot-sheet ;
|
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
M: sequence summary
|
2006-05-20 16:42:33 -04:00
|
|
|
[ dup length # " element " % class word-name % ] "" make ;
|
2005-10-03 20:54:05 -04:00
|
|
|
|
2006-05-15 01:01:47 -04:00
|
|
|
M: quotation sheet 1array ;
|
2005-09-25 21:56:48 -04:00
|
|
|
|
|
|
|
M: vector sheet 1array ;
|
|
|
|
|
|
|
|
M: array sheet 1array ;
|
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
M: hashtable summary
|
|
|
|
"a hashtable storing " swap hash-size number>string
|
|
|
|
" keys" append3 ;
|
|
|
|
|
2006-01-26 23:01:14 -05:00
|
|
|
M: hashtable sheet hash>alist flip ;
|
2005-09-25 21:56:48 -04:00
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
M: word summary ( word -- )
|
|
|
|
dup word-vocabulary [
|
|
|
|
dup interned?
|
|
|
|
"a word in the " "a word orphaned from the " ?
|
|
|
|
swap word-vocabulary " vocabulary" append3
|
|
|
|
] [
|
|
|
|
drop "a uniquely generated symbol"
|
|
|
|
] if ;
|
|
|
|
|
2006-05-25 23:25:00 -04:00
|
|
|
M: input summary ( input -- )
|
2006-05-28 18:35:01 -04:00
|
|
|
"Input: " swap input-string
|
|
|
|
dup string? [ unparse-short ] unless append ;
|
2006-05-25 23:25:00 -04:00
|
|
|
|
2006-07-10 20:12:40 -04:00
|
|
|
M: vocab-link summary ( vocab-link -- )
|
|
|
|
[
|
|
|
|
vocab-link-name dup %
|
|
|
|
" vocabulary (" %
|
|
|
|
words length #
|
|
|
|
" words)" %
|
|
|
|
] "" make ;
|
|
|
|
|
2005-09-25 21:59:22 -04:00
|
|
|
DEFER: describe
|
|
|
|
|
|
|
|
: sheet. ( sheet -- )
|
2006-06-07 23:04:37 -04:00
|
|
|
flip
|
2006-07-28 03:54:46 -04:00
|
|
|
H{ { table-gap { 10 0 } } }
|
2006-06-17 16:51:44 -04:00
|
|
|
[ dup unparse-short swap write-object ]
|
2006-06-09 22:17:12 -04:00
|
|
|
tabular-output ;
|
2005-09-25 21:56:48 -04:00
|
|
|
|
2005-10-03 20:54:05 -04:00
|
|
|
: describe ( object -- ) dup summary print sheet sheet. ;
|
2005-09-25 21:59:22 -04:00
|
|
|
|
2006-07-10 00:51:22 -04:00
|
|
|
: stack. ( seq -- seq ) <reversed> >array sheet sheet. ;
|
2005-09-27 00:24:42 -04:00
|
|
|
|
2005-09-25 21:56:48 -04:00
|
|
|
: .s datastack stack. ;
|
2006-05-14 23:09:47 -04:00
|
|
|
: .r retainstack stack. ;
|
2006-05-18 22:07:00 -04:00
|
|
|
|
|
|
|
: callframe. ( seq pos -- )
|
|
|
|
[
|
2006-05-19 00:19:08 -04:00
|
|
|
hilite-index set dup hilite-quotation set .
|
2006-05-18 22:07:00 -04:00
|
|
|
] with-scope ;
|
|
|
|
|
|
|
|
: callstack. ( seq -- seq )
|
2006-05-19 00:19:08 -04:00
|
|
|
3 swap group <reversed> [ first2 1- callframe. ] each ;
|
2006-05-18 22:07:00 -04:00
|
|
|
|
|
|
|
: .c callstack callstack. ;
|