1 ! Copyright (C) 2005, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays generic hashtables io kernel assocs math
4 namespaces prettyprint prettyprint.custom prettyprint.sections
5 sequences strings io.styles vectors words quotations mirrors
6 splitting math.parser classes vocabs sets sorting summary
7 debugger continuations fry combinators ;
8 FROM: namespaces => set ;
13 : print-summary ( obj -- ) [ summary ] keep write-object ;
17 : sort-unparsed-keys ( assoc -- alist )
20 zip sort-values keys ;
22 GENERIC: add-numbers ( alist -- table' )
27 +number-rows+ get [ [ prefix ] map-index ] when ;
29 TUPLE: slot-name name ;
31 M: slot-name pprint* name>> text ;
33 GENERIC: fix-slot-names ( assoc -- assoc )
35 M: assoc fix-slot-names >alist ;
37 M: mirror fix-slot-names
38 [ [ slot-name boa ] dip ] { } assoc-map-as ;
40 : (describe) ( obj assoc -- keys )
41 t pprint-string-cells? [
42 [ print-summary nl ] [
43 dup hashtable? [ sort-unparsed-keys ] when
44 [ fix-slot-names add-numbers simple-table. ] [ keys ] bi
50 : describe ( obj -- ) dup make-mirror (describe) drop ;
52 M: tuple error. describe ;
54 : vars-in-scope ( seq -- alist )
55 [ [ global eq? not ] filter [ keys ] gather ] keep
56 '[ dup _ assoc-stack ] H{ } map>assoc ;
59 namestack vars-in-scope describe ;
62 error-continuation get name>> vars-in-scope describe ;
68 SYMBOL: inspector-stack
72 : reinspect ( obj -- )
75 dup make-mirror dup mirror set
76 t +number-rows+ [ (describe) ] with-variable
80 : (inspect) ( obj -- )
81 [ inspector-stack get push ] [ reinspect ] bi ;
85 : key@ ( n -- key ) sorted-keys get nth ;
87 : &push ( -- obj ) me get ;
89 : &at ( n -- ) key@ mirror get at (inspect) ;
93 dup length 1 <= [ drop ] [ [ pop* ] [ last reinspect ] bi ] if ;
95 : &add ( value key -- ) mirror get set-at &push reinspect ;
97 : &put ( value n -- ) key@ &add ;
99 : &delete ( n -- ) key@ mirror get delete-at &push reinspect ;
101 : &rename ( key n -- ) key@ mirror get rename-at &push reinspect ;
104 #! A tribute to Slate:
105 "You are in a twisty little maze of objects, all alike." print
107 "'n' is a slot number in the following:" print
109 "&back -- return to previous object" print
110 "&push ( -- obj ) push this object" print
111 "&at ( n -- ) inspect nth slot" print
112 "&put ( value n -- ) change nth slot" print
113 "&add ( value key -- ) add new slot" print
114 "&delete ( n -- ) remove a slot" print
115 "&rename ( key n -- ) change a slot's key" print
116 "&globals ( -- ) inspect global namespace" print
117 "&help -- display this message" print
120 : inspector ( obj -- )
122 V{ } clone inspector-stack set
126 inspector-stack get [ (inspect) ] [ inspector ] if ;
128 : &globals ( -- ) global inspect ;