steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new prettyprinter

cvs
Slava Pestov 2005-08-21 05:17:37 +00:00
parent 5384a2f805
commit 9adffd9388
18 changed files with 331 additions and 262 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO.FACTOR.txt
View File

@ -1,11 +1,5 @@
- flushing optimization
- new prettyprinter
- limit output to n lines
- limit sequences to n elements
- put newlines where necessary
- limit lines to 64 chars
- conditional newlines after certain words
- rename prettyprint* to pprint, prettyprint to pp
- reader syntax for arrays, byte arrays, displaced aliens
- print parsing words in bold
- unify unparse and prettyprint

2
library/bootstrap/primitives.factor
View File

@ -317,6 +317,8 @@ num-types empty-vector builtins set
"tuple" "kernel" create 18 "tuple?" "kernel" create { } define-builtin
"byte-array" "kernel-internals" create 19 "byte-array?" "kernel-internals" create { } define-builtin
"displaced-alien" "alien" create 20 "displaced-alien?" "alien" create { } define-builtin
FORGET: builtin-predicate

3
library/collections/arrays.factor
View File

@ -31,9 +31,6 @@ M: array resize resize-array ;
3dup swap array-nth pick rot set-array-nth
] repeat 2drop ;
DEFER: byte-array?
BUILTIN: byte-array 19 byte-array? ;
M: byte-array length array-capacity ;
M: byte-array resize resize-array ;

2
library/collections/sequences-epilogue.factor
View File

@ -229,7 +229,7 @@ IN: kernel
: cond ( conditions -- )
#! Conditions is a sequence of quotation pairs.
#! { { [ X ] [ Y ] } { [ Z ] [ T ] }
#! { { [ X ] [ Y ] } { [ Z ] [ T ] } }
#! => X [ Y ] [ Z [ T ] [ ] ifte ] ifte
#! The last condition should be a catch-all 't'.
[ first call ] find nip second call ;

8
library/compiler/compiler.factor
View File

@ -12,9 +12,7 @@ io kernel lists math namespaces prettyprint words ;
] unless ;
: compiling ( word -- word parameter )
check-architecture
"Compiling " write dup unparse. terpri flush
dup word-def ;
check-architecture "Compiling " write dup pp dup word-def ;
GENERIC: (compile) ( word -- )
@ -43,7 +41,7 @@ M: compound (compile) ( word -- )
"compile" get [ word compile ] when ; parsing
: cannot-compile ( word error -- )
"Cannot compile " write swap unparse. terpri print-error ;
"Cannot compile " write swap pp print-error ;
: try-compile ( word -- )
[ compile ] [ [ cannot-compile ] when* ] catch ;
@ -52,7 +50,7 @@ M: compound (compile) ( word -- )
: decompile ( word -- )
dup compiled? [
"Decompiling " write dup unparse. terpri flush
"Decompiling " write dup pp
[ word-primitive ] keep set-word-primitive
] [
drop

2
library/httpd/html-tags.factor
View File

@ -84,7 +84,7 @@ USE: sequences
#! With the attribute namespace on the stack, get the attributes
#! and write them to standard output. If no attributes exist, write
#! nothing.
"attrs" get [ bl attrs>string write ] when* ;
"attrs" get [ " " write attrs>string write ] when* ;
: store-prev-attribute ( n: tag value -- )
#! Assumes an attribute namespace is on the stack.

8
library/inference/print-dataflow.factor
View File

@ -1,6 +1,6 @@
IN: inference
USING: generic hashtables inference io kernel kernel-internals
math namespaces prettyprint sequences vectors words ;
lists math namespaces prettyprint sequences styles vectors words ;
! A simple tool for turning dataflow IR into quotations, for
! debugging purposes.
@ -9,9 +9,9 @@ GENERIC: node>quot ( node -- )
TUPLE: comment node text ;
M: comment prettyprint* ( ann -- )
M: comment pprint* ( ann -- )
"( " over comment-text " )" append3
swap comment-node object. ;
swap comment-node presented swons unit format ;
: comment, ( ? node text -- )
rot [ <comment> , ] [ 2drop ] ifte ;
@ -82,4 +82,4 @@ M: #entry node>quot ( ? node -- ) "#entry" comment, ;
: dataflow. ( quot ? -- )
#! Print dataflow IR for a quotation. Flag indicates if
#! annotations should be printed or not.
>r dataflow optimize r> dataflow>quot prettyprint ;
>r dataflow optimize r> dataflow>quot pp ;

2
library/io/directories.factor
View File

@ -15,7 +15,7 @@ strings styles unparser ;
: file. ( dir name -- )
#! If "doc-root" set, create links relative to it.
2dup path+ file-icon. bl file-link. terpri ;
2dup path+ file-icon. " " write file-link. terpri ;
: directory. ( dir -- )
#! If "doc-root" set, create links relative to it.

1
library/io/stdio.factor
View File

@ -15,7 +15,6 @@ USING: errors generic kernel lists namespaces strings styles ;
: close ( -- ) stdio get stream-close ;
: crlf ( -- ) "\r\n" write ;
: bl ( -- ) " " write ;
: write-icon ( resource -- )
#! Write an icon. Eg, /library/icons/File.png

297
library/syntax/prettyprint.factor
View File

@ -1,56 +1,191 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: prettyprint
USING: alien errors generic hashtables io kernel lists math
memory namespaces parser presentation sequences strings
styles unparser vectors words ;
USING: alien generic hashtables io kernel lists math namespaces
parser sequences strings styles unparser vectors words ;
SYMBOL: prettyprint-limit
SYMBOL: one-line
SYMBOL: tab-size
! TODO:
! - newline styles: forced, long output style, normal
! - long output flag, off with .
! - margin & indent calculation fix
! - out of memory when printing global namespace
! - formatting HTML code
! - limit strings
! State
SYMBOL: column
SYMBOL: indent
SYMBOL: last-newline?
SYMBOL: last-newline
SYMBOL: recursion-check
SYMBOL: line-count
SYMBOL: end-printing
GENERIC: prettyprint* ( indent obj -- indent )
! Configuration
SYMBOL: margin
SYMBOL: nesting-limit
SYMBOL: length-limit
SYMBOL: line-limit
: object. ( str obj -- )
presented swons unit format ;
global [
64 margin set
recursion-check off
0 column set
0 indent set
last-newline? off
0 last-newline set
0 line-count set
] bind
: unparse. ( obj -- )
[ unparse ] keep object. ;
TUPLE: pprinter blocks block ;
M: object prettyprint* ( indent obj -- indent )
unparse. ;
GENERIC: pprint-section*
M: word prettyprint* ( indent word -- indent )
dup parsing? [ \ POSTPONE: unparse. bl ] when unparse. ;
TUPLE: section start end ;
: indent ( indent -- )
#! Print the given number of spaces.
CHAR: \s fill write ;
C: section ( length -- section )
>r column [ dup rot + dup ] change r>
[ set-section-end ] keep
[ set-section-start ] keep ;
: prettyprint-newline ( indent -- )
"\n" write indent ;
: section-fits? ( section -- ? )
section-end last-newline get - margin get <= ;
: ?prettyprint-newline ( indent -- )
one-line get [ bl drop ] [ prettyprint-newline ] ifte ;
: line-limit? ( -- ? )
line-limit get dup [ line-count get <= ] when ;
: <prettyprint ( indent -- indent )
tab-size get + dup ?prettyprint-newline ;
: fresh-line ( section -- )
section-start last-newline set
line-count [ 1 + ] change
line-limit? [ " ..." write end-printing get call ] when
terpri indent get CHAR: \s fill write ;
: prettyprint> ( indent -- indent )
tab-size get - one-line get
[ dup prettyprint-newline ] unless ;
TUPLE: text string style ;
: prettyprint-limit? ( indent -- ? )
prettyprint-limit get dup [ >= ] [ nip ] ifte ;
C: text ( string style -- section )
pick length <section> over set-delegate
[ set-text-style ] keep
[ set-text-string ] keep ;
: check-recursion ( indent obj quot -- indent )
M: text pprint-section*
dup text-string swap text-style format ;
TUPLE: block sections ;
C: block ( -- block )
0 <section> over set-delegate
{ } clone over set-block-sections ;
: add-section ( section stream -- )
pprinter-block block-sections push ;
: text ( string style -- )
<text> pprinter get add-section ;
: bl ( -- ) " " f text ;
: pprint-section ( section -- )
last-newline? get [
dup section-fits? [
" " write
] [
dup fresh-line
] ifte last-newline? off
] when pprint-section* ;
TUPLE: newline forced? ;
C: newline ( forced -- section )
1 <section> over set-delegate
[ set-newline-forced? ] keep ;
M: newline pprint-section*
dup newline-forced?
[ fresh-line ] [ drop last-newline? on ] ifte ;
: section-length ( section -- n )
dup section-end swap section-start - ;
: block-indent ( block -- indent )
block-sections first
dup block? [ drop 0 ] [ section-length 1 + ] ifte ;
M: block pprint-section* ( block -- )
indent get dup >r
over block-indent + indent set
block-sections [ pprint-section ] each
r> indent set ;
: <block ( -- )
pprinter get dup pprinter-block over pprinter-blocks push
<block> swap set-pprinter-block ;
: newline ( forced -- )
<newline> pprinter get add-section ;
: end-block ( block -- )
column get swap set-section-end ;
: pop-block ( pprinter -- )
dup pprinter-blocks pop swap set-pprinter-block ;
: block-empty? block-sections empty? ;
: block> ( -- )
pprinter get dup pprinter-block dup block-empty? [
drop pop-block
] [
dup end-block swap dup pop-block add-section
] ifte ;
C: pprinter ( -- stream )
{ } clone over set-pprinter-blocks
<block> over set-pprinter-block ;
: do-pprint ( pprinter -- )
[
end-printing set
dup pprinter-block pprint-section
] callcc0 drop ;
GENERIC: pprint* ( obj -- )
: vocab-style ( vocab -- style )
{{
[[ "syntax" [ [[ foreground [ 128 128 128 ] ]] ] ]]
[[ "kernel" [ [[ foreground [ 0 0 128 ] ]] ] ]]
[[ "sequences" [ [[ foreground [ 128 0 0 ] ]] ] ]]
[[ "math" [ [[ foreground [ 0 128 0 ] ]] ] ]]
[[ "math-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
[[ "kernel-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
[[ "io-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
}} hash ;
: object-style ( obj -- style )
dup word? [ dup word-vocabulary vocab-style ] [ { } ] ifte
swap presented swons add ;
: pprint-object ( obj -- )
dup unparse swap object-style text ;
M: object pprint* ( obj -- )
pprint-object ;
M: word pprint* ( word -- )
dup parsing? [ \ POSTPONE: pprint-object bl ] when
pprint-object ;
: nesting-limit? ( -- ? )
nesting-limit get dup
[ pprinter get pprinter-blocks length < ] when ;
: check-recursion ( obj quot -- indent )
#! We detect circular structure.
pick prettyprint-limit? [
2drop "#" write
nesting-limit? [
2drop "&" f text
] [
over recursion-check get memq? [
2drop "&" write
2drop "#" f text
] [
over recursion-check [ cons ] change
call
@ -58,78 +193,74 @@ M: word prettyprint* ( indent word -- indent )
] ifte
] ifte ; inline
: prettyprint-elements ( indent list -- indent )
[ prettyprint* bl ] each ;
: length-limit? ( seq -- seq ? )
length-limit get dup
[ swap 2dup length < [ head t ] [ nip f ] ifte ]
[ drop f ] ifte ;
: prettyprint-sequence ( indent start list end -- indent )
#! Prettyprint a list, with start/end delimiters; eg, [ ],
#! or { }, or << >>. The body of the list is indented,
#! unless the list is empty.
over [
>r >r unparse. <prettyprint
r> prettyprint-elements
prettyprint> r> unparse.
] [
>r >r unparse. bl r> drop r> unparse.
] ifte ;
: pprint-elements ( seq -- )
length-limit? >r
[ pprint* f newline ] each
r> [ "... " f text ] when ;
M: cons prettyprint* ( indent list -- indent )
: pprint-sequence ( seq start end -- )
<block swap pprint-object f newline
swap pprint-elements pprint-object block> ;
M: cons pprint* ( list -- )
[
dup list? [
\ [ swap \ ]
] [
\ [[ swap uncons 2list \ ]]
] ifte prettyprint-sequence
dup list? [ \ [ \ ] ] [ uncons 2list \ [[ \ ]] ] ifte
pprint-sequence
] check-recursion ;
M: vector prettyprint* ( indent vector -- indent )
[
\ { swap \ } prettyprint-sequence
] check-recursion ;
M: vector pprint* ( vector -- )
[ \ { \ } pprint-sequence ] check-recursion ;
M: hashtable prettyprint* ( indent hashtable -- indent )
[
\ {{ swap hash>alist \ }} prettyprint-sequence
] check-recursion ;
M: hashtable pprint* ( hashtable -- )
[ hash>alist \ {{ \ }} pprint-sequence ] check-recursion ;
M: tuple prettyprint* ( indent tuple -- indent )
[
\ << swap <mirror> \ >> prettyprint-sequence
] check-recursion ;
M: tuple pprint* ( tuple -- )
[ <mirror> \ << \ >> pprint-sequence ] check-recursion ;
M: alien prettyprint* ( alien -- )
\ ALIEN: unparse. bl alien-address unparse write ;
M: alien pprint* ( alien -- )
\ ALIEN: pprint-object bl alien-address pprint-object ;
M: wrapper prettyprint* ( wrapper -- )
M: wrapper pprint* ( wrapper -- )
dup wrapped word? [
\ \ unparse. bl wrapped unparse.
\ \ pprint-object bl wrapped pprint-object
] [
\ W[ unparse. bl wrapped prettyprint* \ ]W unparse.
wrapped 1vector \ W[ \ ]W pprint-sequence
] ifte ;
: prettyprint ( obj -- )
: with-pprint ( quot -- )
[
recursion-check off
0 swap prettyprint* drop terpri
] with-scope ;
<pprinter> pprinter set call pprinter get do-pprint
] with-scope ; inline
: pprint ( object -- )
[ pprint* ] with-pprint ;
: pprint>string ( object -- string )
[ pprint ] string-out ;
: pp ( obj -- ) pprint terpri ;
: . ( obj -- )
[
one-line on
16 prettyprint-limit set
prettyprint
] with-scope ;
[ 2 nesting-limit set 100 length-limit set pp ] with-scope ;
: [.] ( sequence -- )
#! Unparse each element on its own line.
[ . ] each ;
[
1 line-limit set 10 length-limit set
[ pp ] each
] with-scope ;
: .s datastack reverse [.] flush ;
: .r callstack reverse [.] flush ;
: stack. reverse-slice [.] ;
: .s datastack stack. ;
: .r callstack stack. ;
! For integers only
: .b >bin print ;
: .o >oct print ;
: .h >hex print ;
global [ 4 tab-size set ] bind

151
library/syntax/see.factor
View File

@ -1,130 +1,77 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: prettyprint
USING: generic hashtables io kernel lists namespaces sequences
streams strings styles unparser words ;
USING: generic io kernel lists namespaces sequences styles words ;
: prettyprint-IN: ( word -- )
\ IN: unparse. bl word-vocabulary write terpri ;
: declaration. ( word prop -- )
tuck word-name word-prop
[ bl pprint-object ] [ drop ] ifte ;
: prettyprint-prop ( word prop -- )
tuck word-name word-prop [
bl unparse.
] [
drop
] ifte ;
: prettyprint-plist ( word -- )
: declarations. ( word -- )
[
POSTPONE: parsing
POSTPONE: inline
POSTPONE: foldable
POSTPONE: flushable
] [ prettyprint-prop ] each-with ;
] [ declaration. ] each-with ;
: comment. ( comment -- )
[ [[ font-style italic ]] ] format ;
[ [[ font-style italic ]] ] text ;
: infer-effect. ( effect -- )
[
"(" %
2unlist >r [ " " % unparse % ] each r>
" --" %
[ " " % unparse % ] each
" )" %
] make-string comment. ;
: stack-picture ( seq -- string )
[ [ word-name % " " % ] each ] make-string ;
: stack-effect. ( word -- )
dup "stack-effect" word-prop [
[ CHAR: ( , % CHAR: ) , ] make-string
comment.
] [
"infer-effect" word-prop dup [
infer-effect.
] [
drop
] ifte
: effect>string ( effect -- string )
2unseq stack-picture >r stack-picture "-- " r> append3 ;
: stack-effect ( word -- string )
dup "stack-effect" word-prop [ ] [
"infer-effect" word-prop
dup [ effect>string ] when
] ?ifte ;
: documentation. ( indent word -- indent )
"documentation" word-prop [
"\n" split [
"#!" swap append comment.
dup prettyprint-newline
] each
] when* ;
: stack-effect. ( string -- )
[ bl "( " swap ")" append3 comment. ] when* ;
: definer. ( word -- ) dup definer unparse. bl unparse. bl ;
: in. ( word -- )
<block \ IN: pprint-object bl word-vocabulary f text block>
t newline ;
: definer. ( word -- )
dup definer pprint-object bl
dup pprint-object
stack-effect stack-effect.
f newline ;
GENERIC: (see) ( word -- )
M: compound (see) ( word -- )
tab-size get dup indent swap
[ documentation. ] keep
[ word-def prettyprint-elements \ ; unparse. ] keep
prettyprint-plist terpri drop ;
M: word (see) definer. t newline ;
: prettyprint-M: ( -- indent )
\ M: unparse. bl tab-size get ;
: documentation. ( word -- )
"documentation" word-prop [
"\n" split [ "#!" swap append comment. t newline ] each
] when* ;
: prettyprint-; \ ; unparse. terpri ;
: see-body ( quot word -- )
dup definer. <block dup documentation. swap pprint-elements
\ ; pprint-object declarations. block> ;
M: compound (see)
dup word-def swap see-body t newline ;
: method. ( word [[ class method ]] -- )
uncons >r >r >r prettyprint-M: r> r> unparse. bl unparse. bl
dup prettyprint-newline r> prettyprint-elements
prettyprint-; drop ;
<block
\ M: pprint-object bl
unswons pprint-object bl
swap pprint-object t newline
pprint-elements \ ; pprint-object
block> t newline ;
M: generic (see) ( word -- )
tab-size get dup indent [
one-line on
over "picker" word-prop prettyprint* bl
over "combination" word-prop prettyprint* bl
] with-scope
drop
\ ; unparse.
dup prettyprint-plist
terpri
M: generic (see)
<block
dup dup { "picker" "combination" } [ word-prop ] map-with
swap see-body block> t newline
dup methods [ method. ] each-with ;
M: word (see) drop ;
GENERIC: class.
M: union class.
\ UNION: unparse. bl
dup unparse. bl
0 swap "members" word-prop prettyprint-elements drop
prettyprint-; ;
M: complement class.
\ COMPLEMENT: unparse. bl
dup unparse. bl
"complement" word-prop unparse. terpri ;
M: predicate class.
\ PREDICATE: unparse. bl
dup "superclass" word-prop unparse. bl
dup unparse. bl
tab-size get dup prettyprint-newline swap
"definition" word-prop prettyprint-elements drop
prettyprint-; ;
M: tuple-class class.
\ TUPLE: unparse. bl
dup unparse. bl
"slot-names" word-prop [ write bl ] each
prettyprint-; ;
M: word class. drop ;
: see ( word -- )
dup prettyprint-IN: dup definer.
dup stack-effect. terpri dup (see) class. ;
: methods. ( class -- )
#! List all methods implemented for this class.
dup class.
dup implementors [
dup prettyprint-IN:
[ "methods" word-prop hash* ] keep swap method.
] each-with ;
[ dup in. (see) ] with-pprint ;

4
library/test/interpreter.factor
View File

@ -80,10 +80,6 @@ USE: sequences
[ [ 2 2 + unparse print ] string-out ] test-interpreter
] unit-test
[ { "4" } ] [
[ [ 0 2 2 + prettyprint* drop ] string-out ] test-interpreter
] unit-test
[ { "4\n" } ] [
[ [ 2 2 + . ] string-out ] test-interpreter
] unit-test

41
library/test/prettyprint.factor Normal file
View File

@ -0,0 +1,41 @@
IN: temporary
USING: io kernel math sequences test xp ;
[ "4" ] [ 4 pprint>string ] unit-test
[ "1.0" ] [ 1.0 pprint>string ] unit-test
[ "#{ 1/2 2/3 }#" ] [ #{ 1/2 2/3 }# pprint>string ] unit-test
[ "1267650600228229401496703205376" ] [ 1 100 shift pprint>string ] unit-test
[ "+" ] [ \ + pprint>string ] unit-test
[ "\\ +" ] [ [ \ + ] first pprint>string ] unit-test
[ "1" ] [
[ [ <block 1 pprint-object block> ] with-pprint ] string-out
] unit-test
[ "{ }" ] [ { } pprint>string ] unit-test
[ "{ 1 2 3 }" ] [ { 1 2 3 } pprint>string ] unit-test
[ "\"hello\\\\backslash\"" ]
[ "hello\\backslash" pprint>string ]
unit-test
[ "\"\\u1234\"" ]
[ "\u1234" pprint>string ]
unit-test
[ "\"\\e\"" ]
[ "\e" pprint>string ]
unit-test
[ "f" ] [ f pprint>string ] unit-test
[ "t" ] [ t pprint>string ] unit-test
[ "SBUF\" hello world\"" ] [ SBUF" hello world" pprint>string ] unit-test
: foo dup * ; inline
[ "IN: temporary\n: foo dup * ; inline\n" ]
[ [ \ foo see ] string-out ] unit-test

32
library/test/unparser.factor
View File

@ -1,32 +0,0 @@
IN: temporary
USE: lists
USE: math
USE: parser
USE: test
USE: unparser
USE: kernel
USE: kernel-internals
USE: io-internals
[ "\"hello\\\\backslash\"" ]
[ "hello\\backslash" unparse ]
unit-test
[ "\"\\u1234\"" ]
[ "\u1234" unparse ]
unit-test
[ "\"\\e\"" ]
[ "\e" unparse ]
unit-test
[ "1.0" ] [ 1.0 unparse ] unit-test
[ "f" ] [ f unparse ] unit-test
[ "t" ] [ t unparse ] unit-test
[ "car" ] [ \ car unparse ] unit-test
[ "#{ 1/2 2/3 }#" ] [ #{ 1/2 2/3 }# unparse ] unit-test
[ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
[ ] [ { 1 2 3 } unparse drop ] unit-test
[ "SBUF\" hello world\"" ] [ SBUF" hello world" unparse ] unit-test

10
library/tools/debugger.factor
View File

@ -17,8 +17,8 @@ vectors words ;
: type-check-error. ( list -- )
"Type check error" print
uncons car dup "Object: " write .
"Object type: " write class unparse. terpri
"Expected type: " write type>class unparse. terpri ;
"Object type: " write class pp
"Expected type: " write type>class pp ;
: float-format-error. ( list -- )
"Invalid floating point literal format: " write . ;
@ -102,10 +102,8 @@ M: object error. ( error -- ) . ;
: :get ( var -- value ) "error-namestack" get (get) ;
: debug-help ( -- )
[ :s :r ] [ unparse. bl ] each
"show stacks at time of error." print
\ :get unparse.
" ( var -- value ) inspects the error namestack." print ;
":s :r show stacks at time of error." print
":get ( var -- value ) inspects the error namestack." print ;
: flush-error-handler ( error -- )
#! Last resort.

8
library/tools/inspector.factor
View File

@ -57,16 +57,16 @@ M: word extra-banner ( obj -- )
dup vocab-banner
metaclass [
"This is a class whose behavior is specifed by the " write
unparse. " metaclass." print
pprint " metaclass." print
] when* ;
M: object extra-banner ( obj -- ) drop ;
: inspect-banner ( obj -- )
"You are looking at an instance of the " write dup class unparse.
"You are looking at an instance of the " write dup class pprint
" class:" print
" " write dup unparse. terpri
"It takes up " write dup size unparse write " bytes of memory." print
" " write dup pp
"It takes up " write dup size pprint " bytes of memory." print
extra-banner ;
: describe ( obj -- )

14
library/tools/walker.factor
View File

@ -42,14 +42,12 @@ sequences io strings vectors words ;
set-callstack call ;
: walk-banner ( -- )
[ &s &r ] [ unparse. bl ] each
"show stepper stacks." print
\ &get unparse.
" ( var -- value ) inspects the stepper namestack." print
\ step unparse. " -- single step over" print
\ into unparse. " -- single step into" print
\ continue unparse. " -- continue execution" print
\ bye unparse. " -- exit single-stepper" print
"&s &r show stepper stacks." print
"&get ( var -- value ) inspects the stepper namestack." print
"step -- single step over" print
"into -- single step into" print
"continue -- continue execution" print
"bye -- exit single-stepper" print
report ;
: walk-listener walk-banner "walk " listener-prompt set listener ;

2
library/ui/presentations.factor
View File

@ -47,7 +47,7 @@ global [ 100 <vector> commands set ] bind
"This stream does not support live gadgets"
swap format terpri ;
[ drop t ] "Prettyprint" [ prettyprint ] define-command
[ drop t ] "Prettyprint" [ pp ] define-command
[ drop t ] "Inspect" [ inspect ] define-command
[ drop t ] "References" [ references inspect ] define-command