new words: browser words. vocab.; inspector supports outlining

cvs
Slava Pestov 2005-09-26 01:54:25 +00:00
parent da134d62d8
commit a5d1b36114
7 changed files with 46 additions and 42 deletions

View File

@ -1,8 +1,9 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: inference IN: inference
USING: arrays errors generic interpreter io kernel lists math USING: arrays errors generic inspector interpreter io kernel
namespaces parser prettyprint sequences strings vectors words ; lists math namespaces parser prettyprint sequences strings
vectors words ;
! This variable takes a boolean value. ! This variable takes a boolean value.
SYMBOL: inferring-base-case SYMBOL: inferring-base-case
@ -21,7 +22,7 @@ M: inference-error error. ( error -- )
"! Inference error:" print "! Inference error:" print
dup inference-error-message print dup inference-error-message print
"! Recursive state:" print "! Recursive state:" print
inference-error-rstate sequence. ; inference-error-rstate describe ;
M: value literal-value ( value -- ) M: value literal-value ( value -- )
{ {

View File

@ -316,10 +316,10 @@ M: wrapper pprint* ( wrapper -- )
: pprint ( object -- ) [ pprint* ] with-pprint ; : pprint ( object -- ) [ pprint* ] with-pprint ;
: unparse ( object -- str ) [ pprint ] string-out ;
: . ( obj -- ) pprint terpri ; : . ( obj -- ) pprint terpri ;
: unparse ( object -- str ) [ pprint ] string-out ;
: pprint-short ( object -- string ) : pprint-short ( object -- string )
[ [
1 line-limit set 1 line-limit set
@ -329,17 +329,7 @@ M: wrapper pprint* ( wrapper -- )
pprint pprint
] with-scope ; ] with-scope ;
: unparse-short ( object -- str ) [ pprint-short ] string-out ; : short. ( object -- ) pprint-short terpri ;
: short. ( object -- )
dup unparse-short swap write-object terpri ;
: sequence. ( sequence -- ) [ short. ] each ;
: stack. ( sequence -- ) reverse-slice sequence. ;
: .s datastack stack. ;
: .r callstack stack. ;
! For integers only ! For integers only
: .b >bin print ; : .b >bin print ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: errors IN: errors
USING: generic kernel kernel-internals lists math namespaces USING: generic inspector kernel kernel-internals lists math
parser prettyprint sequences io sequences-internals namespaces parser prettyprint sequences io sequences-internals
strings vectors words ; strings vectors words ;
: expired-error. ( obj -- ) : expired-error. ( obj -- )
@ -100,8 +100,8 @@ M: string error. ( error -- ) print ;
M: object error. ( error -- ) . ; M: object error. ( error -- ) . ;
: :s ( -- ) "error-datastack" get stack. ; : :s ( -- ) "error-datastack" stack. ;
: :r ( -- ) "error-callstack" get stack. ; : :r ( -- ) "error-callstack" stack. ;
: :get ( var -- value ) "error-namestack" get (get) ; : :get ( var -- value ) "error-namestack" get (get) ;

View File

@ -22,22 +22,34 @@ M: array sheet 1array ;
M: hashtable sheet dup hash-keys swap hash-values 2array ; M: hashtable sheet dup hash-keys swap hash-values 2array ;
: format-column ( list -- list ) : format-column ( list -- list )
[ unparse-short ] map [ [ pprint-short ] string-out ] map
[ 0 [ length max ] reduce ] keep [ 0 [ length max ] reduce ] keep
[ swap CHAR: \s pad-right ] map-with ; [ swap CHAR: \s pad-right ] map-with ;
: sheet-numbers ( sheet -- sheet )
dup first length >array 1array swap append ;
SYMBOL: inspector-slots
: format-sheet ( sheet -- list ) : format-sheet ( sheet -- list )
sheet-numbers [ format-column ] map flip [ " " join ] map ;
dup peek inspector-slots set
[ format-column ] map
flip
[ " | " join ] map ;
: describe ( object -- )
sheet dup format-sheet swap peek
[ dup [ describe ] curry write-outliner ] 2each ;
: word. ( word -- )
dup word-name swap dup [ see ] curry write-outliner ;
: vocab. ( vocab -- )
f over [ words [ word. ] each ] curry write-outliner ;
: browser ( -- )
#! Outlining word browser.
vocabs [ vocab. ] each ;
: stack. ( seq -- seq )
reverse-slice >array describe ;
: .s datastack stack. ;
: .r callstack stack. ;
! Interactive inspector
GENERIC: extra-banner ( obj -- ) GENERIC: extra-banner ( obj -- )
M: word extra-banner ( word -- ) M: word extra-banner ( word -- )
@ -63,9 +75,11 @@ M: object extra-banner ( obj -- ) drop ;
"It takes up " write dup size pprint " bytes of memory." print "It takes up " write dup size pprint " bytes of memory." print
extra-banner ; extra-banner ;
: describe ( obj -- ) SYMBOL: inspector-slots
sheet dup format-sheet swap peek
[ write-object terpri ] 2each ; : sheet-numbers ( sheet -- sheet )
dup first length >array 1array swap append
dup peek inspector-slots set ;
SYMBOL: inspector-stack SYMBOL: inspector-stack
@ -73,7 +87,8 @@ SYMBOL: inspector-stack
: (inspect) ( obj -- ) : (inspect) ( obj -- )
dup inspector-stack get push dup inspector-stack get push
dup inspect-banner describe ; dup inspect-banner
sheet sheet-numbers sheet. ;
: inspector-help ( -- ) : inspector-help ( -- )
"Object inspector." print "Object inspector." print

View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: interpreter IN: interpreter
USING: errors kernel listener lists math namespaces prettyprint USING: errors inspector kernel listener lists math namespaces
sequences io strings vectors words ; prettyprint sequences io strings vectors words ;
! The single-stepper simulates Factor in Factor to allow ! The single-stepper simulates Factor in Factor to allow
! single-stepping through the execution of a quotation. It can ! single-stepping through the execution of a quotation. It can

View File

@ -6,8 +6,9 @@ DEFER: <tutorial-button>
IN: gadgets-listener IN: gadgets-listener
USING: gadgets gadgets-labels gadgets-layouts gadgets-panes USING: gadgets gadgets-labels gadgets-layouts gadgets-panes
gadgets-presentations gadgets-scrolling gadgets-splitters gadgets-presentations gadgets-scrolling gadgets-splitters
generic hashtables help io kernel listener lists math namespaces generic hashtables help inspector io kernel listener lists math
prettyprint sdl sequences shells styles threads words ; namespaces prettyprint sdl sequences shells styles threads
words ;
SYMBOL: datastack-display SYMBOL: datastack-display
SYMBOL: callstack-display SYMBOL: callstack-display

View File

@ -27,9 +27,6 @@ SYMBOL: commands
: <command-button> ( gadget object -- button ) : <command-button> ( gadget object -- button )
[ nip command-menu ] curry <menu-button> ; [ nip command-menu ] curry <menu-button> ;
: <object-button> ( object -- button )
[ unparse-short <label> ] keep <command-button> ;
: init-commands ( gadget -- gadget ) : init-commands ( gadget -- gadget )
dup presented paint-prop [ <command-button> ] when* ; dup presented paint-prop [ <command-button> ] when* ;