factor/library/tools/describe.factor

101 lines
2.3 KiB
Factor
Raw Normal View History

2006-05-20 16:42:33 -04:00
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: inspector
USING: arrays generic hashtables io kernel kernel-internals
math namespaces prettyprint sequences strings styles vectors
words ;
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 "
swap quadrant { "first" "second" "fourth" "third" } nth
2005-10-03 20:54:05 -04:00
" quadrant" append3 ;
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 )
dup class "slots" word-prop
2006-05-02 03:05:57 -04:00
dup [ third ] map -rot
[ 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 ;
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 ;
M: hashtable sheet hash>alist flip ;
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 ;
M: input summary ( input -- )
2006-05-28 18:35:01 -04:00
"Input: " swap input-string
dup string? [ unparse-short ] unless append ;
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 } } }
[ dup unparse-short swap write-object ]
tabular-output ;
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
: .s datastack stack. ;
2006-05-14 23:09:47 -04:00
: .r retainstack stack. ;
: callframe. ( seq pos -- )
[
hilite-index set dup hilite-quotation set .
] with-scope ;
: callstack. ( seq -- seq )
3 swap group <reversed> [ first2 1- callframe. ] each ;
: .c callstack callstack. ;