new words: browser words. vocab.; inspector supports outlining
parent
da134d62d8
commit
a5d1b36114
|
@ -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 -- )
|
||||||
{
|
{
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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) ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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* ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue