Merge branch 'master' of git://factorcode.org/git/factor
						commit
						e14d06a566
					
				| 
						 | 
				
			
			@ -1,11 +1,11 @@
 | 
			
		|||
! Copyright (C) 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: vocabs vocabs.loader kernel ;
 | 
			
		||||
USING: vocabs vocabs.loader kernel io.thread threads
 | 
			
		||||
compiler.utilities namespaces ;
 | 
			
		||||
IN: bootstrap.threads
 | 
			
		||||
 | 
			
		||||
USE: io.thread
 | 
			
		||||
USE: threads
 | 
			
		||||
 | 
			
		||||
"debugger" vocab [
 | 
			
		||||
    "debugger.threads" require
 | 
			
		||||
] when
 | 
			
		||||
 | 
			
		||||
[ yield ] yield-hook set-global
 | 
			
		||||
| 
						 | 
				
			
			@ -1,9 +1,9 @@
 | 
			
		|||
! Copyright (C) 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: namespaces make math math.order math.parser sequences accessors
 | 
			
		||||
kernel kernel.private layouts assocs words summary arrays
 | 
			
		||||
combinators classes.algebra alien alien.c-types alien.structs
 | 
			
		||||
alien.strings alien.arrays sets threads libc continuations.private
 | 
			
		||||
alien.strings alien.arrays sets libc continuations.private
 | 
			
		||||
fry cpu.architecture
 | 
			
		||||
compiler.errors
 | 
			
		||||
compiler.alien
 | 
			
		||||
| 
						 | 
				
			
			@ -11,7 +11,8 @@ compiler.cfg
 | 
			
		|||
compiler.cfg.instructions
 | 
			
		||||
compiler.cfg.registers
 | 
			
		||||
compiler.cfg.builder
 | 
			
		||||
compiler.codegen.fixup ;
 | 
			
		||||
compiler.codegen.fixup
 | 
			
		||||
compiler.utilities ;
 | 
			
		||||
IN: compiler.codegen
 | 
			
		||||
 | 
			
		||||
GENERIC: generate-insn ( insn -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -463,7 +464,7 @@ TUPLE: callback-context ;
 | 
			
		|||
    dup current-callback eq? [
 | 
			
		||||
        drop
 | 
			
		||||
    ] [
 | 
			
		||||
        yield wait-to-return
 | 
			
		||||
        yield-hook get call wait-to-return
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: do-callback ( quot token -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,14 +1,14 @@
 | 
			
		|||
! Copyright (C) 2004, 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2004, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors kernel namespaces arrays sequences io
 | 
			
		||||
words fry continuations vocabs assocs dlists definitions math
 | 
			
		||||
threads graphs generic combinators deques search-deques io
 | 
			
		||||
graphs generic combinators deques search-deques io
 | 
			
		||||
stack-checker stack-checker.state stack-checker.inlining
 | 
			
		||||
compiler.errors compiler.units compiler.tree.builder
 | 
			
		||||
compiler.tree.optimizer compiler.cfg.builder
 | 
			
		||||
compiler.cfg.optimizer compiler.cfg.linearization
 | 
			
		||||
compiler.cfg.two-operand compiler.cfg.linear-scan
 | 
			
		||||
compiler.cfg.stack-frame compiler.codegen ;
 | 
			
		||||
compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
 | 
			
		||||
IN: compiler
 | 
			
		||||
 | 
			
		||||
SYMBOL: compile-queue
 | 
			
		||||
| 
						 | 
				
			
			@ -107,7 +107,7 @@ t compile-dependencies? set-global
 | 
			
		|||
    ] with-return ;
 | 
			
		||||
 | 
			
		||||
: compile-loop ( deque -- )
 | 
			
		||||
    [ (compile) yield ] slurp-deque ;
 | 
			
		||||
    [ (compile) yield-hook get call ] slurp-deque ;
 | 
			
		||||
 | 
			
		||||
: decompile ( word -- )
 | 
			
		||||
    f 2array 1array t modify-code-heap ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel sequences sequences.private arrays vectors fry
 | 
			
		||||
math.order ;
 | 
			
		||||
math.order namespaces assocs ;
 | 
			
		||||
IN: compiler.utilities
 | 
			
		||||
 | 
			
		||||
: flattener ( seq quot -- seq vector quot' )
 | 
			
		||||
| 
						 | 
				
			
			@ -21,3 +21,7 @@ IN: compiler.utilities
 | 
			
		|||
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
 | 
			
		||||
 | 
			
		||||
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
 | 
			
		||||
 | 
			
		||||
SYMBOL: yield-hook
 | 
			
		||||
 | 
			
		||||
yield-hook global [ [ ] or ] change-at
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2007 Daniel Ehrenberg
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: delegate sequences.private sequences assocs
 | 
			
		||||
io definitions kernel continuations ;
 | 
			
		||||
io io.styles definitions kernel continuations ;
 | 
			
		||||
IN: delegate.protocols
 | 
			
		||||
 | 
			
		||||
PROTOCOL: sequence-protocol
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -183,7 +183,7 @@ ARTICLE: "io" "Input and output"
 | 
			
		|||
{ $subsection "io.streams.byte-array" }
 | 
			
		||||
{ $heading "Utilities" }
 | 
			
		||||
{ $subsection "stream-binary" }
 | 
			
		||||
{ $subsection "styles" }
 | 
			
		||||
{ $subsection "io.styles" }
 | 
			
		||||
{ $subsection "checksums" }
 | 
			
		||||
{ $heading "Implementation" }
 | 
			
		||||
{ $subsection "io.streams.c" }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,116 @@
 | 
			
		|||
USING: help.markup help.syntax io.streams.plain io strings
 | 
			
		||||
hashtables ;
 | 
			
		||||
hashtables kernel quotations ;
 | 
			
		||||
IN: io.styles
 | 
			
		||||
 | 
			
		||||
HELP: stream-format
 | 
			
		||||
{ $values { "str" string } { "style" "a hashtable" } { "stream" "an output stream" } }
 | 
			
		||||
{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-block-stream
 | 
			
		||||
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
 | 
			
		||||
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
 | 
			
		||||
$nl
 | 
			
		||||
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: stream-write-table
 | 
			
		||||
{ $values { "table-cells" "a sequence of sequences of table cells" } { "style" "a hashtable" } { "stream" "an output stream" } }
 | 
			
		||||
{ $contract "Prints a table of cells produced by " { $link with-cell } "."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-cell-stream
 | 
			
		||||
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
 | 
			
		||||
{ $contract "Creates an output stream which writes to a table cell object." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-span-stream
 | 
			
		||||
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
 | 
			
		||||
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
 | 
			
		||||
$nl
 | 
			
		||||
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: format
 | 
			
		||||
{ $values { "str" string } { "style" "a hashtable" } }
 | 
			
		||||
{ $description "Writes formatted text to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link stream-format } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-nesting
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a nested paragraph stream, with formatting information applied." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link make-block-stream } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: tabular-output
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on " { $link output-stream } "."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
 | 
			
		||||
{ $examples
 | 
			
		||||
    { $code
 | 
			
		||||
        "{ { 1 2 } { 3 4 } }"
 | 
			
		||||
        "H{ { table-gap { 10 10 } } } ["
 | 
			
		||||
        "    [ [ [ [ . ] with-cell ] each ] with-row ] each"
 | 
			
		||||
        "] tabular-output"
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-row
 | 
			
		||||
{ $values { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation which emits a series of table cells using " { $link with-cell } ". This word can only be called inside the quotation given to " { $link tabular-output } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-cell
 | 
			
		||||
{ $values { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation in a new scope with " { $link output-stream } " rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: write-cell
 | 
			
		||||
{ $values { "str" string } }
 | 
			
		||||
{ $description "Outputs a table cell containing a single string. This word can only be called inside the quotation given to " { $link with-row } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-style
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link make-span-stream } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "formatted-stream-protocol" "Formatted stream protocol"
 | 
			
		||||
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text."
 | 
			
		||||
{ $subsection stream-format }
 | 
			
		||||
{ $subsection make-span-stream }
 | 
			
		||||
{ $subsection make-block-stream }
 | 
			
		||||
{ $subsection make-cell-stream }
 | 
			
		||||
{ $subsection stream-write-table } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "formatted-stdout" "Formatted output on the default stream"
 | 
			
		||||
"The below words perform formatted output on " { $link output-stream } "."
 | 
			
		||||
$nl
 | 
			
		||||
"Formatted output:"
 | 
			
		||||
{ $subsection format }
 | 
			
		||||
{ $subsection with-style }
 | 
			
		||||
{ $subsection with-nesting }
 | 
			
		||||
"Tabular output:"
 | 
			
		||||
{ $subsection tabular-output }
 | 
			
		||||
{ $subsection with-row }
 | 
			
		||||
{ $subsection with-cell }
 | 
			
		||||
{ $subsection write-cell } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "character-styles" "Character styles"
 | 
			
		||||
"Character styles for " { $link stream-format } " and " { $link with-style } ":"
 | 
			
		||||
{ $subsection foreground }
 | 
			
		||||
| 
						 | 
				
			
			@ -33,7 +142,7 @@ ARTICLE: "presentations" "Presentations"
 | 
			
		|||
"The " { $link presented } " style can be used to emit clickable objects. A utility word for outputting this style:"
 | 
			
		||||
{ $subsection write-object } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "styles" "Formatted output"
 | 
			
		||||
ARTICLE: "styles" "Styled text"
 | 
			
		||||
"The " { $link stream-format } ", " { $link with-style } ", " { $link with-nesting } " and " { $link tabular-output } " words take a hashtable of style attributes. Output stream implementations are free to ignore style information."
 | 
			
		||||
$nl
 | 
			
		||||
"Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary."
 | 
			
		||||
| 
						 | 
				
			
			@ -42,7 +151,13 @@ $nl
 | 
			
		|||
{ $subsection "table-styles" }
 | 
			
		||||
{ $subsection "presentations" } ;
 | 
			
		||||
 | 
			
		||||
ABOUT: "styles"
 | 
			
		||||
ARTICLE: "io.styles" "Formatted output"
 | 
			
		||||
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for formatted output. This is used by the prettyprinter, help system, and various developer tools. Implementations include " { $vocab-link "ui.gadgets.panes" } ", " { $vocab-link "html.streams" } ", and " { $vocab-link "io.streams.plain" } "."
 | 
			
		||||
{ $subsection "formatted-stream-protocol" }
 | 
			
		||||
{ $subsection "formatted-stdout" }
 | 
			
		||||
{ $subsection "styles" } ;
 | 
			
		||||
 | 
			
		||||
ABOUT: "io.styles"
 | 
			
		||||
 | 
			
		||||
HELP: plain
 | 
			
		||||
{ $description "A value for the " { $link font-style } " character style denoting plain text." } ;
 | 
			
		||||
| 
						 | 
				
			
			@ -157,3 +272,12 @@ HELP: <input>
 | 
			
		|||
HELP: standard-table-style
 | 
			
		||||
{ $values { "style" hashtable } }
 | 
			
		||||
{ $description "Outputs a table style where cells are separated by 5-pixel gaps and framed by a light gray border. This style can be passed to " { $link tabular-output } "." } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "io.streams.plain" "Plain writer streams"
 | 
			
		||||
"Plain writer streams wrap an underlying stream and provide a default implementation of "
 | 
			
		||||
{ $link stream-nl } ", "
 | 
			
		||||
{ $link stream-format } ", "
 | 
			
		||||
{ $link make-span-stream } ", "
 | 
			
		||||
{ $link make-block-stream } " and "
 | 
			
		||||
{ $link make-cell-stream } "."
 | 
			
		||||
{ $subsection plain-writer } ;
 | 
			
		||||
| 
						 | 
				
			
			@ -1,9 +1,139 @@
 | 
			
		|||
! Copyright (C) 2005, 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2005, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: hashtables io colors summary make accessors splitting
 | 
			
		||||
kernel ;
 | 
			
		||||
USING: hashtables io io.streams.plain io.streams.string
 | 
			
		||||
colors summary make accessors splitting math.order
 | 
			
		||||
kernel namespaces assocs destructors strings sequences ;
 | 
			
		||||
IN: io.styles
 | 
			
		||||
 | 
			
		||||
GENERIC: stream-format ( str style stream -- )
 | 
			
		||||
GENERIC: make-span-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: make-block-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: make-cell-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: stream-write-table ( table-cells style stream -- )
 | 
			
		||||
 | 
			
		||||
: format ( str style -- ) output-stream get stream-format ;
 | 
			
		||||
 | 
			
		||||
: tabular-output ( style quot -- )
 | 
			
		||||
    swap [ { } make ] dip output-stream get stream-write-table ; inline
 | 
			
		||||
 | 
			
		||||
: with-row ( quot -- )
 | 
			
		||||
    { } make , ; inline
 | 
			
		||||
 | 
			
		||||
: with-cell ( quot -- )
 | 
			
		||||
    H{ } output-stream get make-cell-stream
 | 
			
		||||
    [ swap with-output-stream ] keep , ; inline
 | 
			
		||||
 | 
			
		||||
: write-cell ( str -- )
 | 
			
		||||
    [ write ] with-cell ; inline
 | 
			
		||||
 | 
			
		||||
: with-style ( style quot -- )
 | 
			
		||||
    swap dup assoc-empty? [
 | 
			
		||||
        drop call
 | 
			
		||||
    ] [
 | 
			
		||||
        output-stream get make-span-stream swap with-output-stream
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
 | 
			
		||||
: with-nesting ( style quot -- )
 | 
			
		||||
    [ output-stream get make-block-stream ] dip
 | 
			
		||||
    with-output-stream ; inline
 | 
			
		||||
 | 
			
		||||
TUPLE: filter-writer stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-format
 | 
			
		||||
    stream>> stream-format ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write
 | 
			
		||||
    stream>> stream-write ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write1
 | 
			
		||||
    stream>> stream-write1 ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-span-stream
 | 
			
		||||
    stream>> make-span-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-block-stream
 | 
			
		||||
    stream>> make-block-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-cell-stream
 | 
			
		||||
    stream>> make-cell-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-flush
 | 
			
		||||
    stream>> stream-flush ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-nl
 | 
			
		||||
    stream>> stream-nl ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write-table
 | 
			
		||||
    stream>> stream-write-table ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer dispose
 | 
			
		||||
    stream>> dispose ;
 | 
			
		||||
 | 
			
		||||
TUPLE: ignore-close-stream < filter-writer ;
 | 
			
		||||
 | 
			
		||||
M: ignore-close-stream dispose drop ;
 | 
			
		||||
 | 
			
		||||
C: <ignore-close-stream> ignore-close-stream
 | 
			
		||||
 | 
			
		||||
TUPLE: style-stream < filter-writer style ;
 | 
			
		||||
 | 
			
		||||
: do-nested-style ( style style-stream -- style stream )
 | 
			
		||||
    [ style>> swap assoc-union ] [ stream>> ] bi ; inline
 | 
			
		||||
 | 
			
		||||
C: <style-stream> style-stream
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-format
 | 
			
		||||
    do-nested-style stream-format ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write
 | 
			
		||||
    [ style>> ] [ stream>> ] bi stream-format ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write1
 | 
			
		||||
    [ 1string ] dip stream-write ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-span-stream
 | 
			
		||||
    do-nested-style make-span-stream ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-block-stream
 | 
			
		||||
    [ do-nested-style make-block-stream ] [ style>> ] bi
 | 
			
		||||
    <style-stream> ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-cell-stream
 | 
			
		||||
    [ do-nested-style make-cell-stream ] [ style>> ] bi
 | 
			
		||||
    <style-stream> ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write-table
 | 
			
		||||
    [ [ [ stream>> ] map ] map ] [ ] [ stream>> ] tri*
 | 
			
		||||
    stream-write-table ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer stream-format
 | 
			
		||||
    nip stream-write ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-span-stream
 | 
			
		||||
    swap <style-stream> <ignore-close-stream> ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-block-stream
 | 
			
		||||
    nip <ignore-close-stream> ;
 | 
			
		||||
 | 
			
		||||
: format-column ( seq ? -- seq )
 | 
			
		||||
    [
 | 
			
		||||
        [ 0 [ length max ] reduce ] keep
 | 
			
		||||
        swap [ CHAR: \s pad-right ] curry map
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: map-last ( seq quot -- seq )
 | 
			
		||||
    [ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
 | 
			
		||||
 | 
			
		||||
: format-table ( table -- seq )
 | 
			
		||||
    flip [ format-column ] map-last
 | 
			
		||||
    flip [ " " join ] map ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer stream-write-table
 | 
			
		||||
    [ drop format-table [ print ] each ] with-output-stream* ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-cell-stream 2drop <string-writer> ;
 | 
			
		||||
 | 
			
		||||
! Font styles
 | 
			
		||||
SYMBOL: plain
 | 
			
		||||
SYMBOL: bold
 | 
			
		||||
SYMBOL: italic
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
USING: arrays generic hashtables io kernel math assocs
 | 
			
		||||
namespaces make sequences strings io.styles vectors words
 | 
			
		||||
prettyprint.config splitting classes continuations
 | 
			
		||||
io.streams.nested accessors sets ;
 | 
			
		||||
accessors sets ;
 | 
			
		||||
IN: prettyprint.sections
 | 
			
		||||
 | 
			
		||||
! State
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2006, 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2006, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: arrays kernel math namespaces make sequences words io
 | 
			
		||||
io.streams.string math.vectors ui.gadgets columns accessors
 | 
			
		||||
io.styles math.vectors ui.gadgets columns accessors
 | 
			
		||||
math.geometry.rect locals fry ;
 | 
			
		||||
IN: ui.gadgets.grids
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6,7 +6,7 @@ ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 | 
			
		|||
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 | 
			
		||||
hashtables io kernel namespaces sequences io.styles strings
 | 
			
		||||
quotations math opengl combinators math.vectors sorting
 | 
			
		||||
splitting io.streams.nested assocs ui.gadgets.presentations
 | 
			
		||||
splitting assocs ui.gadgets.presentations
 | 
			
		||||
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
 | 
			
		||||
classes.tuple models continuations destructors accessors
 | 
			
		||||
math.geometry.rect fry ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -57,45 +57,6 @@ HELP: stream-nl
 | 
			
		|||
{ $notes "Most code only works on one stream at a time and should instead use " { $link nl } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: stream-format
 | 
			
		||||
{ $values { "str" string } { "style" "a hashtable" } { "stream" "an output stream" } }
 | 
			
		||||
{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-block-stream
 | 
			
		||||
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
 | 
			
		||||
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
 | 
			
		||||
$nl
 | 
			
		||||
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: stream-write-table
 | 
			
		||||
{ $values { "table-cells" "a sequence of sequences of table cells" } { "style" "a hashtable" } { "stream" "an output stream" } }
 | 
			
		||||
{ $contract "Prints a table of cells produced by " { $link with-cell } "."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-cell-stream
 | 
			
		||||
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
 | 
			
		||||
{ $contract "Creates an output stream which writes to a table cell object." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: make-span-stream
 | 
			
		||||
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
 | 
			
		||||
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
 | 
			
		||||
$nl
 | 
			
		||||
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
 | 
			
		||||
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: stream-print
 | 
			
		||||
{ $values { "str" string } { "stream" "an output stream" } }
 | 
			
		||||
| 
						 | 
				
			
			@ -161,54 +122,6 @@ HELP: nl
 | 
			
		|||
{ $description "Writes a line terminator to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: format
 | 
			
		||||
{ $values { "str" string } { "style" "a hashtable" } }
 | 
			
		||||
{ $description "Writes formatted text to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link stream-format } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-nesting
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a nested paragraph stream, with formatting information applied." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link make-block-stream } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: tabular-output
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on " { $link output-stream } "."
 | 
			
		||||
$nl
 | 
			
		||||
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
 | 
			
		||||
{ $examples
 | 
			
		||||
    { $code
 | 
			
		||||
        "{ { 1 2 } { 3 4 } }"
 | 
			
		||||
        "H{ { table-gap { 10 10 } } } ["
 | 
			
		||||
        "    [ [ [ [ . ] with-cell ] each ] with-row ] each"
 | 
			
		||||
        "] tabular-output"
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-row
 | 
			
		||||
{ $values { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation which emits a series of table cells using " { $link with-cell } ". This word can only be called inside the quotation given to " { $link tabular-output } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-cell
 | 
			
		||||
{ $values { "quot" quotation } }
 | 
			
		||||
{ $description "Calls a quotation in a new scope with " { $link output-stream } " rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: write-cell
 | 
			
		||||
{ $values { "str" string } }
 | 
			
		||||
{ $description "Outputs a table cell containing a single string. This word can only be called inside the quotation given to " { $link with-row } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: with-style
 | 
			
		||||
{ $values { "style" "a hashtable" } { "quot" quotation } }
 | 
			
		||||
{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." }
 | 
			
		||||
{ $notes "Details are in the documentation for " { $link make-span-stream } "." }
 | 
			
		||||
$io-error ;
 | 
			
		||||
 | 
			
		||||
HELP: print
 | 
			
		||||
{ $values { "string" string } }
 | 
			
		||||
{ $description "Writes a newline-terminated string to " { $link output-stream } "." }
 | 
			
		||||
| 
						 | 
				
			
			@ -279,12 +192,7 @@ $nl
 | 
			
		|||
{ $subsection stream-flush }
 | 
			
		||||
{ $subsection stream-write1 }
 | 
			
		||||
{ $subsection stream-write }
 | 
			
		||||
{ $subsection stream-format }
 | 
			
		||||
{ $subsection stream-nl }
 | 
			
		||||
{ $subsection make-span-stream }
 | 
			
		||||
{ $subsection make-block-stream }
 | 
			
		||||
{ $subsection make-cell-stream }
 | 
			
		||||
{ $subsection stream-write-table }
 | 
			
		||||
{ $see-also "io.timeouts" } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "stdio" "Default input and output streams"
 | 
			
		||||
| 
						 | 
				
			
			@ -347,15 +255,6 @@ $nl
 | 
			
		|||
{ $subsection print }
 | 
			
		||||
{ $subsection nl }
 | 
			
		||||
{ $subsection bl }
 | 
			
		||||
"Formatted output:"
 | 
			
		||||
{ $subsection format }
 | 
			
		||||
{ $subsection with-style }
 | 
			
		||||
{ $subsection with-nesting }
 | 
			
		||||
"Tabular output:"
 | 
			
		||||
{ $subsection tabular-output }
 | 
			
		||||
{ $subsection with-row }
 | 
			
		||||
{ $subsection with-cell }
 | 
			
		||||
{ $subsection write-cell }
 | 
			
		||||
"A pair of combinators for rebinding the " { $link output-stream } " variable:"
 | 
			
		||||
{ $subsection with-output-stream }
 | 
			
		||||
{ $subsection with-output-stream* }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
! Copyright (C) 2003, 2007 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2003, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: hashtables generic kernel math namespaces make sequences
 | 
			
		||||
continuations destructors assocs ;
 | 
			
		||||
| 
						 | 
				
			
			@ -13,11 +13,6 @@ GENERIC: stream-write1 ( ch stream -- )
 | 
			
		|||
GENERIC: stream-write ( str stream -- )
 | 
			
		||||
GENERIC: stream-flush ( stream -- )
 | 
			
		||||
GENERIC: stream-nl ( stream -- )
 | 
			
		||||
GENERIC: stream-format ( str style stream -- )
 | 
			
		||||
GENERIC: make-span-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: make-block-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: make-cell-stream ( style stream -- stream' )
 | 
			
		||||
GENERIC: stream-write-table ( table-cells style stream -- )
 | 
			
		||||
 | 
			
		||||
: stream-print ( str stream -- )
 | 
			
		||||
    [ stream-write ] keep stream-nl ;
 | 
			
		||||
| 
						 | 
				
			
			@ -46,7 +41,6 @@ SYMBOL: error-stream
 | 
			
		|||
: flush ( -- ) output-stream get stream-flush ;
 | 
			
		||||
 | 
			
		||||
: nl ( -- ) output-stream get stream-nl ;
 | 
			
		||||
: format ( str style -- ) output-stream get stream-format ;
 | 
			
		||||
 | 
			
		||||
: with-input-stream* ( stream quot -- )
 | 
			
		||||
    input-stream swap with-variable ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -68,30 +62,6 @@ SYMBOL: error-stream
 | 
			
		|||
    [ [ drop dispose dispose ] 3curry ] 3bi
 | 
			
		||||
    [ ] cleanup ; inline
 | 
			
		||||
 | 
			
		||||
: tabular-output ( style quot -- )
 | 
			
		||||
    swap [ { } make ] dip output-stream get stream-write-table ; inline
 | 
			
		||||
 | 
			
		||||
: with-row ( quot -- )
 | 
			
		||||
    { } make , ; inline
 | 
			
		||||
 | 
			
		||||
: with-cell ( quot -- )
 | 
			
		||||
    H{ } output-stream get make-cell-stream
 | 
			
		||||
    [ swap with-output-stream ] keep , ; inline
 | 
			
		||||
 | 
			
		||||
: write-cell ( str -- )
 | 
			
		||||
    [ write ] with-cell ; inline
 | 
			
		||||
 | 
			
		||||
: with-style ( style quot -- )
 | 
			
		||||
    swap dup assoc-empty? [
 | 
			
		||||
        drop call
 | 
			
		||||
    ] [
 | 
			
		||||
        output-stream get make-span-stream swap with-output-stream
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
 | 
			
		||||
: with-nesting ( style quot -- )
 | 
			
		||||
    [ output-stream get make-block-stream ] dip
 | 
			
		||||
    with-output-stream ; inline
 | 
			
		||||
 | 
			
		||||
: print ( string -- ) output-stream get stream-print ;
 | 
			
		||||
 | 
			
		||||
: bl ( -- ) " " write ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Slava Pestov
 | 
			
		||||
| 
						 | 
				
			
			@ -1,2 +0,0 @@
 | 
			
		|||
USING: io io.streams.nested help.markup help.syntax ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -1,74 +0,0 @@
 | 
			
		|||
! Copyright (C) 2006, 2008 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: arrays generic assocs kernel namespaces strings
 | 
			
		||||
quotations io continuations destructors accessors sequences ;
 | 
			
		||||
IN: io.streams.nested
 | 
			
		||||
 | 
			
		||||
TUPLE: filter-writer stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-format
 | 
			
		||||
    stream>> stream-format ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write
 | 
			
		||||
    stream>> stream-write ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write1
 | 
			
		||||
    stream>> stream-write1 ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-span-stream
 | 
			
		||||
    stream>> make-span-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-block-stream
 | 
			
		||||
    stream>> make-block-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer make-cell-stream
 | 
			
		||||
    stream>> make-cell-stream ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-flush
 | 
			
		||||
    stream>> stream-flush ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-nl
 | 
			
		||||
    stream>> stream-nl ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer stream-write-table
 | 
			
		||||
    stream>> stream-write-table ;
 | 
			
		||||
 | 
			
		||||
M: filter-writer dispose
 | 
			
		||||
    stream>> dispose ;
 | 
			
		||||
 | 
			
		||||
TUPLE: ignore-close-stream < filter-writer ;
 | 
			
		||||
 | 
			
		||||
M: ignore-close-stream dispose drop ;
 | 
			
		||||
 | 
			
		||||
C: <ignore-close-stream> ignore-close-stream
 | 
			
		||||
 | 
			
		||||
TUPLE: style-stream < filter-writer style ;
 | 
			
		||||
 | 
			
		||||
: do-nested-style ( style style-stream -- style stream )
 | 
			
		||||
    [ style>> swap assoc-union ] [ stream>> ] bi ; inline
 | 
			
		||||
 | 
			
		||||
C: <style-stream> style-stream
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-format
 | 
			
		||||
    do-nested-style stream-format ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write
 | 
			
		||||
    [ style>> ] [ stream>> ] bi stream-format ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write1
 | 
			
		||||
    [ 1string ] dip stream-write ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-span-stream
 | 
			
		||||
    do-nested-style make-span-stream ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-block-stream
 | 
			
		||||
    [ do-nested-style make-block-stream ] [ style>> ] bi
 | 
			
		||||
    <style-stream> ;
 | 
			
		||||
 | 
			
		||||
M: style-stream make-cell-stream
 | 
			
		||||
    [ do-nested-style make-cell-stream ] [ style>> ] bi
 | 
			
		||||
    <style-stream> ;
 | 
			
		||||
 | 
			
		||||
M: style-stream stream-write-table
 | 
			
		||||
    [ [ [ stream>> ] map ] map ] [ ] [ stream>> ] tri*
 | 
			
		||||
    stream-write-table ;
 | 
			
		||||
| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Support for with-stream-style implementation
 | 
			
		||||
| 
						 | 
				
			
			@ -1,15 +1,6 @@
 | 
			
		|||
USING: help.markup help.syntax io ;
 | 
			
		||||
IN: io.streams.plain
 | 
			
		||||
 | 
			
		||||
ARTICLE: "io.streams.plain" "Plain writer streams"
 | 
			
		||||
"Plain writer streams wrap an underlying stream and provide a default implementation of "
 | 
			
		||||
{ $link stream-nl } ", "
 | 
			
		||||
{ $link stream-format } ", "
 | 
			
		||||
{ $link make-span-stream } ", "
 | 
			
		||||
{ $link make-block-stream } " and "
 | 
			
		||||
{ $link make-cell-stream } "."
 | 
			
		||||
{ $subsection plain-writer } ;
 | 
			
		||||
 | 
			
		||||
ABOUT: "io.streams.plain"
 | 
			
		||||
 | 
			
		||||
HELP: plain-writer
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,18 +1,9 @@
 | 
			
		|||
! Copyright (C) 2005, 2007 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2005, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel io io.streams.nested ;
 | 
			
		||||
USING: kernel io ;
 | 
			
		||||
IN: io.streams.plain
 | 
			
		||||
 | 
			
		||||
MIXIN: plain-writer
 | 
			
		||||
 | 
			
		||||
M: plain-writer stream-nl
 | 
			
		||||
    CHAR: \n swap stream-write1 ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer stream-format
 | 
			
		||||
    nip stream-write ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-span-stream
 | 
			
		||||
    swap <style-stream> <ignore-close-stream> ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-block-stream
 | 
			
		||||
    nip <ignore-close-stream> ;
 | 
			
		||||
    CHAR: \n swap stream-write1 ;
 | 
			
		||||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
! Copyright (C) 2003, 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2003, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors io kernel math namespaces sequences sbufs
 | 
			
		||||
strings generic splitting continuations destructors
 | 
			
		||||
| 
						 | 
				
			
			@ -17,21 +17,8 @@ SINGLETON: null-encoding
 | 
			
		|||
 | 
			
		||||
M: null-encoding decode-char drop stream-read1 ;
 | 
			
		||||
 | 
			
		||||
: format-column ( seq ? -- seq )
 | 
			
		||||
    [
 | 
			
		||||
        [ 0 [ length max ] reduce ] keep
 | 
			
		||||
        swap [ CHAR: \s pad-right ] curry map
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: map-last ( seq quot -- seq )
 | 
			
		||||
    [ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: format-table ( table -- seq )
 | 
			
		||||
    flip [ format-column ] map-last
 | 
			
		||||
    flip [ " " join ] map ;
 | 
			
		||||
 | 
			
		||||
M: growable dispose drop ;
 | 
			
		||||
 | 
			
		||||
M: growable stream-write1 push ;
 | 
			
		||||
| 
						 | 
				
			
			@ -78,8 +65,3 @@ M: growable stream-read-partial
 | 
			
		|||
    [ <string-reader> ] dip with-input-stream ; inline
 | 
			
		||||
 | 
			
		||||
INSTANCE: growable plain-writer
 | 
			
		||||
 | 
			
		||||
M: plain-writer stream-write-table
 | 
			
		||||
    [ drop format-table [ print ] each ] with-output-stream* ;
 | 
			
		||||
 | 
			
		||||
M: plain-writer make-cell-stream 2drop <string-writer> ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -57,8 +57,6 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
SYMBOL: load-help?
 | 
			
		||||
 | 
			
		||||
ERROR: circular-dependency name ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: load-source ( vocab -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue