new prettyprinter

TODO.FACTOR.txt

@@ -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

library/bootstrap/primitives.factor

@@ -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

library/collections/arrays.factor

@@ -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 ;
 

library/collections/sequences-epilogue.factor

@@ -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 ;

library/compiler/compiler.factor

@@ -12,9 +12,7 @@ io kernel lists math namespaces prettyprint words ;
     ] unless ;
 
 : compiling ( word -- word parameter )
-    check-architecture
+    check-architecture "Compiling " write dup pp dup word-def ;
-    "Compiling " write dup unparse. terpri flush
-    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

library/httpd/html-tags.factor

@@ -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.

library/inference/print-dataflow.factor

@@ -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 ;

library/io/directories.factor

@@ -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.

library/io/stdio.factor

@@ -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

library/syntax/prettyprint.factor

@@ -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
+USING: alien generic hashtables io kernel lists math namespaces
-memory namespaces parser presentation sequences strings
+parser sequences strings styles unparser vectors words ;
-styles unparser vectors words ;
 
-SYMBOL: prettyprint-limit
+! TODO:
-SYMBOL: one-line
+! - newline styles: forced, long output style, normal
-SYMBOL: tab-size
+! - 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 -- )
+global [
-    presented swons unit format ;
+    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 -- )
+TUPLE: pprinter blocks block ;
-    [ unparse ] keep object. ;
 
-M: object prettyprint* ( indent obj -- indent )
+GENERIC: pprint-section*
-    unparse. ;
 
-M: word prettyprint* ( indent word -- indent )
+TUPLE: section start end ;
-    dup parsing? [ \ POSTPONE: unparse. bl ] when unparse. ;
 
-: indent ( indent -- )
+C: section ( length -- section )
-    #! Print the given number of spaces.
+    >r column [ dup rot + dup ] change r>
-    CHAR: \s fill write ;
+    [ set-section-end ] keep
+    [ set-section-start ] keep ;
 
-: prettyprint-newline ( indent -- )
+: section-fits? ( section -- ? )
-    "\n" write indent ;
+    section-end last-newline get - margin get <= ;
 
-: ?prettyprint-newline ( indent -- )
+: line-limit? ( -- ? )
-    one-line get [ bl drop ] [ prettyprint-newline ] ifte ;
+    line-limit get dup [ line-count get <= ] when ;
 
-: <prettyprint ( indent -- indent )
+: fresh-line ( section -- )
-    tab-size get + dup ?prettyprint-newline ;
+    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 )
+TUPLE: text string style ;
-    tab-size get - one-line get
-    [ dup prettyprint-newline ] unless ;
 
-: prettyprint-limit? ( indent -- ? )
+C: text ( string style -- section )
-    prettyprint-limit get dup [ >= ] [ nip ] ifte ;
+    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? [
+    nesting-limit? [
-        2drop "#" write
+        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 )
+: length-limit? ( seq -- seq ? )
-    [ prettyprint* bl ] each ;
+    length-limit get dup
+    [ swap 2dup length < [ head t ] [ nip f ] ifte ]
+    [ drop f ] ifte ;
 
-: prettyprint-sequence ( indent start list end -- indent )
+: pprint-elements ( seq -- )
-    #! Prettyprint a list, with start/end delimiters; eg, [ ],
+    length-limit? >r
-    #! or { }, or << >>. The body of the list is indented,
+    [ pprint* f newline ] each
-    #! unless the list is empty.
+    r> [ "... " f text ] when ;
-    over [
-        >r >r unparse. <prettyprint
-        r> prettyprint-elements
-        prettyprint> r> unparse.
-    ] [
-        >r >r unparse. bl r> drop r> unparse.
-    ] ifte ;
 
-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? [
+       dup list? [ \ [ \ ] ] [ uncons 2list \ [[ \ ]] ] ifte
-           \ [ swap \ ]
+       pprint-sequence
-       ] [
-           \ [[ swap uncons 2list \ ]]
-       ] ifte prettyprint-sequence
    ] check-recursion ;
 
-M: vector prettyprint* ( indent vector -- indent )
+M: vector pprint* ( vector -- )
-    [
+    [ \ { \ } pprint-sequence ] check-recursion ;
-        \ { swap \ } prettyprint-sequence
-    ] check-recursion ;
 
-M: hashtable prettyprint* ( indent hashtable -- indent )
+M: hashtable pprint* ( hashtable -- )
-    [
+    [ hash>alist \ {{ \ }} pprint-sequence ] check-recursion ;
-        \ {{ swap hash>alist \ }} prettyprint-sequence
-    ] check-recursion ;
 
-M: tuple prettyprint* ( indent tuple -- indent )
+M: tuple pprint* ( tuple -- )
-    [
+    [ <mirror> \ << \ >> pprint-sequence ] check-recursion ;
-        \ << swap <mirror> \ >> prettyprint-sequence
-    ] check-recursion ;
 
-M: alien prettyprint* ( alien -- )
+M: alien pprint* ( alien -- )
-    \ ALIEN: unparse. bl alien-address unparse write ;
+    \ 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
+        <pprinter> pprinter set call pprinter get do-pprint
-        0 swap prettyprint* drop terpri
+    ] with-scope ; inline
-    ] with-scope ;
+
+: pprint ( object -- )
+    [ pprint* ] with-pprint ;
+
+: pprint>string ( object -- string )
+    [ pprint ] string-out ;
+
+: pp ( obj -- ) pprint terpri ;
 
 : . ( obj -- )
-    [
+    [ 2 nesting-limit set 100 length-limit set pp ] with-scope ;
-        one-line on
-        16 prettyprint-limit set
-        prettyprint
-    ] 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 ;
+: stack. reverse-slice [.] ;
-: .r callstack  reverse [.] flush ;
+
+: .s datastack stack. ;
+: .r callstack stack. ;
 
 ! For integers only
 : .b >bin print ;
 : .o >oct print ;
 : .h >hex print ;
-
-global [ 4 tab-size set ] bind

library/syntax/see.factor

@@ -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
+USING: generic io kernel lists namespaces sequences styles words ;
-streams strings styles unparser words ;
 
-: prettyprint-IN: ( word -- )
+: declaration. ( word prop -- )
-    \ IN: unparse. bl word-vocabulary write terpri ;
+    tuck word-name word-prop
+    [ bl pprint-object ] [ drop ] ifte ;
 
-: prettyprint-prop ( word prop -- )
+: declarations. ( word -- )
-    tuck word-name word-prop [
-        bl unparse.
-    ] [
-        drop
-    ] ifte ;
-
-: prettyprint-plist ( 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 -- )
+: stack-picture ( seq -- string )
-    [
+    [ [ word-name % " " % ] each ] make-string ;
-        "(" %
-        2unlist >r [ " " % unparse % ] each r>
-        " --" %
-        [ " " % unparse % ] each
-        " )" %
-    ] make-string comment. ;
 
-: stack-effect. ( word -- )
+: effect>string ( effect -- string )
-    dup "stack-effect" word-prop [
+    2unseq stack-picture >r stack-picture "-- " r> append3 ;
-        [ CHAR: ( , % CHAR: ) , ] make-string
+
-        comment.
+: stack-effect ( word -- string )
-    ] [
+    dup "stack-effect" word-prop [ ] [
-        "infer-effect" word-prop dup [
+        "infer-effect" word-prop
-            infer-effect.
+        dup [ effect>string ] when
-        ] [
-            drop
-        ] ifte
     ] ?ifte ;
 
-: documentation. ( indent word -- indent )
+: stack-effect. ( string -- )
-    "documentation" word-prop [
+    [ bl "( " swap ")" append3 comment. ] when* ;
-        "\n" split [
-            "#!" swap append comment.
-            dup prettyprint-newline
-        ] each
-    ] 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 -- )
+M: word (see) definer. t newline ;
-    tab-size get dup indent swap
-    [ documentation. ] keep
-    [ word-def prettyprint-elements \ ; unparse. ] keep
-    prettyprint-plist terpri drop ;
 
-: prettyprint-M: ( -- indent )
+: documentation. ( word -- )
-    \ M: unparse. bl tab-size get ;
+    "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
+    <block
-    dup prettyprint-newline r> prettyprint-elements
+    \ M: pprint-object bl
-    prettyprint-; drop ;
+    unswons pprint-object bl
+    swap pprint-object t newline
+    pprint-elements \ ; pprint-object
+    block> t newline ;
 
-M: generic (see) ( word -- )
+M: generic (see)
-    tab-size get dup indent [
+    <block
-        one-line on
+    dup dup { "picker" "combination" } [ word-prop ] map-with
-        over "picker" word-prop prettyprint* bl
+    swap see-body block> t newline
-        over "combination" word-prop prettyprint* bl
-    ] with-scope
-    drop
-    \ ; unparse.
-    dup prettyprint-plist
-    terpri
     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 in. (see) ] with-pprint ;
-    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 ;

library/test/interpreter.factor

@@ -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

library/test/prettyprint.factor

@@ -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

library/test/unparser.factor

@@ -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

library/tools/debugger.factor

@@ -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
+    "Object type: " write class pp
-    "Expected type: " write type>class unparse. terpri ;
+    "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
+    ":s :r show stacks at time of error." print
-    "show stacks at time of error." print
+    ":get ( var -- value ) inspects the error namestack." print ;
-    \ :get unparse.
-    " ( var -- value ) inspects the error namestack." print ;
 
 : flush-error-handler ( error -- )
     #! Last resort.

library/tools/inspector.factor

@@ -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
+    "  " write dup pp
-    "It takes up " write dup size unparse write " bytes of memory." print
+    "It takes up " write dup size pprint " bytes of memory." print
     extra-banner ;
 
 : describe ( obj -- )

library/tools/walker.factor

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

library/ui/presentations.factor

@@ -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