Massive name change in files, string streams

db4
Daniel Ehrenberg 2008-02-15 22:20:31 -06:00
parent 989b7a468a
commit f6845d43d3
69 changed files with 143 additions and 150 deletions

View File

@ -315,7 +315,7 @@ FUNCTION: double ffi_test_36 ( test-struct-12 x ) ;
data-gc ;
[ "Hello world" ] [
[ callback-4 callback_test_1 ] string-out
[ callback-4 callback_test_1 ] with-string-writer
] unit-test
: callback-5

View File

@ -416,7 +416,7 @@ M: curry '
"Writing image to " write
architecture get boot-image-name resource-path
dup write "..." print flush
<file-writer> [ (write-image) ] with-stream ;
[ (write-image) ] with-file-writer ;
PRIVATE>

View File

@ -63,7 +63,7 @@ UNION: bah fixnum alien ;
! Test generic see and parsing
[ "USING: alien math ;\nIN: temporary\nUNION: bah fixnum alien ;\n" ]
[ [ \ bah see ] string-out ] unit-test
[ [ \ bah see ] with-string-writer ] unit-test
! Test redefinition of classes
UNION: union-1 fixnum float ;

View File

@ -8,4 +8,4 @@ f describe
H{ } describe
H{ } describe
[ "fixnum instance\n" ] [ [ 3 describe ] string-out ] unit-test
[ "fixnum instance\n" ] [ [ 3 describe ] with-string-writer ] unit-test

View File

@ -52,12 +52,12 @@ HELP: <file-appender>
{ $description "Outputs an output stream for writing to the specified pathname. The stream begins writing at the end of the file." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: with-file-in
HELP: with-file-reader
{ $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file is unreadable." } ;
HELP: with-file-out
HELP: with-file-writer
{ $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for writing and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;

View File

@ -6,9 +6,9 @@ USING: tools.test io.files io threads kernel continuations ;
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
"test-foo.txt" resource-path <file-writer> [
"test-foo.txt" resource-path [
"Hello world." print
] with-stream
] with-file-writer
] unit-test
[ ] [
@ -55,11 +55,11 @@ USING: tools.test io.files io threads kernel continuations ;
[ f ] [ "test-blah" resource-path exists? ] unit-test
[ ] [ "test-quux.txt" resource-path <file-writer> [ [ yield "Hi" write ] in-thread ] with-stream ] unit-test
[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" resource-path delete-file ] unit-test
[ ] [ "test-quux.txt" resource-path <file-writer> [ [ yield "Hi" write ] in-thread ] with-stream ] unit-test
[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" "quux-test.txt" [ resource-path ] 2apply rename-file ] unit-test
[ t ] [ "quux-test.txt" resource-path exists? ] unit-test

View File

@ -116,11 +116,10 @@ HOOK: copy-file io-backend ( from to -- )
M: object copy-file
dup parent-directory make-directories
<file-writer> [
stdio get swap
<file-reader> [
stdio get swap stream-copy
] with-stream
] with-stream ;
swap <file-reader> [
swap stream-copy
] with-disposal
] with-disposal ;
: copy-directory ( from to -- )
dup make-directories
@ -146,10 +145,10 @@ M: pathname <=> [ pathname-string ] compare ;
: file-contents ( path -- str )
dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;
: with-file-in ( path quot -- )
: with-file-writer ( path quot -- )
>r <file-reader> r> with-stream ; inline
: with-file-out ( path quot -- )
: with-file-reader ( path quot -- )
>r <file-writer> r> with-stream ; inline
: with-file-appender ( path quot -- )

View File

@ -53,7 +53,7 @@ IN: temporary
] unit-test
[ ] [
image <file-reader> [
image [
10 [ 65536 read drop ] times
] with-stream
] with-file-reader
] unit-test

View File

@ -2,9 +2,9 @@ USING: tools.test io.files io io.streams.c ;
IN: temporary
[ "hello world" ] [
"test.txt" resource-path <file-writer> [
"test.txt" resource-path [
"hello world" write
] with-stream
] with-file-writer
"test.txt" resource-path "rb" fopen <c-reader> contents
] unit-test

View File

@ -6,8 +6,8 @@ ARTICLE: "io.streams.string" "String streams"
{ $subsection <string-reader> }
{ $subsection <string-writer> }
"Utility combinators:"
{ $subsection string-in }
{ $subsection string-out } ;
{ $subsection with-string-reader }
{ $subsection with-string-writer } ;
ABOUT: "io.streams.string"
@ -15,7 +15,7 @@ HELP: <string-writer>
{ $values { "stream" "an output stream" } }
{ $description "Creates an output stream that collects text into a delegate string buffer. The contents of the buffer can be recovered by executing " { $link >string } ", and indeed all other sequence operations are permitted by virtue of the delegation." } ;
HELP: string-out
HELP: with-string-writer
{ $values { "quot" quotation } { "str" string } }
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new string writer. The accumulated string is output when the quotation returns." } ;
@ -24,6 +24,6 @@ HELP: <string-reader>
{ $description "Creates a new stream for reading " { $snippet "str" } " from beginning to end." }
{ $notes "The implementation exploits the ability of string buffers to respond to the input stream protocol by reading characters from the end of the buffer." } ;
HELP: string-in
HELP: with-string-reader
{ $values { "str" string } { "quot" quotation } }
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end. The accumulated string is output when the quotation returns." } ;

View File

@ -12,7 +12,7 @@ unit-test
[ "" <string-reader> stream-readln ]
unit-test
[ "xyzzy" ] [ [ "xyzzy" write ] string-out ] unit-test
[ "xyzzy" ] [ [ "xyzzy" write ] with-string-writer ] unit-test
[ "a" ] [ 1 SBUF" cba" stream-read ] unit-test
[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test

View File

@ -14,7 +14,7 @@ M: growable stream-flush drop ;
: <string-writer> ( -- stream )
512 <sbuf> <plain-writer> ;
: string-out ( quot -- str )
: with-string-writer ( quot -- str )
<string-writer> swap [ stdio get ] compose with-stream*
>string ; inline
@ -75,7 +75,7 @@ M: growable stream-read-partial
: <string-reader> ( str -- stream )
>sbuf dup reverse-here <line-reader> ;
: string-in ( str quot -- )
: with-string-reader ( str quot -- )
>r <string-reader> r> with-stream ; inline
: <byte-reader> ( byte-array encoding -- stream )

View File

@ -32,7 +32,7 @@ IN: temporary
[ overflow-d-alt ] [ { "kernel-error" 12 f f } = ] must-fail-with
[ ] [ [ :c ] string-out drop ] unit-test
[ ] [ [ :c ] with-string-writer drop ] unit-test
: overflow-r 3 >r overflow-r ;
@ -80,8 +80,8 @@ IN: temporary
[ 0 ] [ f [ 0 ] unless* ] unit-test
[ t ] [ t [ "Hello" ] unless* ] unit-test
[ "2\n" ] [ [ 1 2 [ . ] [ sq . ] ?if ] string-out ] unit-test
[ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?if ] string-out ] unit-test
[ "2\n" ] [ [ 1 2 [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
[ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
[ f ] [ f (clone) ] unit-test
[ -123 ] [ -123 (clone) ] unit-test

View File

@ -513,4 +513,4 @@ SYMBOL: interactive-vocabs
[
parser-notes off
[ [ eval ] keep ] try drop
] string-out ;
] with-string-writer ;

View File

@ -67,19 +67,19 @@ unit-test
[ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test
[ t ] [
100 \ dup <array> [ pprint-short ] string-out
100 \ dup <array> [ pprint-short ] with-string-writer
"{" head?
] unit-test
: foo ( a -- b ) dup * ; inline
[ "USING: kernel math ;\nIN: temporary\n: foo ( a -- b ) dup * ; inline\n" ]
[ [ \ foo see ] string-out ] unit-test
[ [ \ foo see ] with-string-writer ] unit-test
: bar ( x -- y ) 2 + ;
[ "USING: math ;\nIN: temporary\n: bar ( x -- y ) 2 + ;\n" ]
[ [ \ bar see ] string-out ] unit-test
[ [ \ bar see ] with-string-writer ] unit-test
: blah
drop
@ -105,7 +105,7 @@ unit-test
[ "drop ;" ] [
\ blah f "inferred-effect" set-word-prop
[ \ blah see ] string-out "\n" ?tail drop 6 tail*
[ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
] unit-test
: check-see ( expect name -- )
@ -116,7 +116,7 @@ unit-test
[ parse-fresh drop ] with-compilation-unit
[
"temporary" lookup see
] string-out "\n" split 1 head*
] with-string-writer "\n" split 1 head*
] keep =
] with-scope ;
@ -295,7 +295,7 @@ unit-test
"IN: temporary\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
dup eval
"generic-decl-test" "temporary" lookup
[ see ] string-out =
[ see ] with-string-writer =
] unit-test
[ [ + ] ] [

View File

@ -63,9 +63,9 @@ combinators quotations ;
: pprint-use ( obj -- ) [ pprint* ] with-use ;
: unparse ( obj -- str ) [ pprint ] string-out ;
: unparse ( obj -- str ) [ pprint ] with-string-writer ;
: unparse-use ( obj -- str ) [ pprint-use ] string-out ;
: unparse-use ( obj -- str ) [ pprint-use ] with-string-writer ;
: pprint-short ( obj -- )
H{
@ -192,7 +192,7 @@ M: pathname synopsis* pprint* ;
0 margin set
1 line-limit set
[ synopsis* ] with-in
] string-out ;
] with-string-writer ;
GENERIC: declarations. ( obj -- )

View File

@ -112,7 +112,7 @@ SYMBOL: end
{ "boolean" [ "\0" = not ] }
{ "string" [ "" or ] }
{ "integer" [ be> ] }
{ "array" [ "" or [ read-array ] string-in ] }
{ "array" [ "" or [ read-array ] with-string-reader ] }
} case ;
: read-ber ( syntax -- object )

View File

@ -101,7 +101,7 @@ HINTS: random fixnum ;
n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta
n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
drop
] with-file-out
] with-file-writer
] with-locals ;

View File

@ -57,8 +57,7 @@ IN: benchmark.knucleotide
: knucleotide ( -- )
"extra/benchmark/knucleotide/knucleotide-input.txt" resource-path
<file-reader>
[ read-input ] with-stream
[ read-input ] with-file-reader
process-input ;
MAIN: knucleotide

View File

@ -65,7 +65,7 @@ SYMBOL: cols
] with-scope ;
: mandel-main ( -- )
"mandel.ppm" resource-path <file-writer>
[ mandel write ] with-stream ;
"mandel.ppm" resource-path
[ mandel write ] with-file-writer ;
MAIN: mandel-main

View File

@ -171,6 +171,6 @@ DEFER: create ( level c r -- scene )
: raytracer-main
"raytracer.pnm" resource-path
<file-writer> [ run write ] with-stream ;
[ run write ] with-file-writer ;
MAIN: raytracer-main

View File

@ -5,7 +5,7 @@ IN: benchmark.sum-file
readln [ string>number + sum-file-loop ] when* ;
: sum-file ( file -- )
<file-reader> [ 0 sum-file-loop ] with-stream . ;
[ 0 sum-file-loop ] with-file-reader . ;
: sum-file-main ( -- )
home "sum-file-in.txt" path+ sum-file ;

View File

@ -11,7 +11,7 @@ bootstrap.image sequences io namespaces io.launcher math ;
: compute-checksums ( -- )
"checksums.txt" [
boot-image-names [ dup write bl file>md5str print ] each
] with-file-out ;
] with-file-writer ;
: upload-images ( -- )
[

View File

@ -48,7 +48,7 @@ VAR: stamp
: git-id ( -- id )
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-writer ;
: make-clean ( -- desc ) { "make" "clean" } ;
@ -132,9 +132,9 @@ SYMBOL: build-status
"Did not pass test-all: " print "../test-all-vocabs" cat
"Benchmarks: " print
"../benchmarks" [ stdio get contents eval ] with-file-in benchmarks.
"../benchmarks" [ stdio get contents eval ] with-file-reader benchmarks.
] with-file-out
] with-file-writer
build-status on ;

View File

@ -11,17 +11,17 @@ USING: kernel namespaces sequences assocs builder continuations
IN: builder.test
: do-load ( -- )
try-everything keys "../load-everything-vocabs" [ . ] with-file-out ;
try-everything keys "../load-everything-vocabs" [ . ] with-file-writer ;
: do-tests ( -- )
run-all-tests keys "../test-all-vocabs" [ . ] with-file-out ;
run-all-tests keys "../test-all-vocabs" [ . ] with-file-writer ;
: do-benchmarks ( -- ) run-benchmarks "../benchmarks" [ . ] with-file-out ;
: do-benchmarks ( -- ) run-benchmarks "../benchmarks" [ . ] with-file-writer ;
: do-all ( -- )
bootstrap-time get "../boot-time" [ . ] with-file-out
[ do-load ] runtime "../load-time" [ . ] with-file-out
[ do-tests ] runtime "../test-time" [ . ] with-file-out
bootstrap-time get "../boot-time" [ . ] with-file-writer
[ do-load ] runtime "../load-time" [ . ] with-file-writer
[ do-tests ] runtime "../test-time" [ . ] with-file-writer
do-benchmarks ;
MAIN: do-all

View File

@ -14,7 +14,7 @@ IN: builder.util
: minutes>ms ( min -- ms ) 60 * 1000 * ;
: file>string ( file -- string ) [ stdio get contents ] with-file-in ;
: file>string ( file -- string ) [ stdio get contents ] with-file-reader ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -18,13 +18,7 @@ IN: bunny.model
] when* ;
: parse-model ( stream -- vs is )
[
100000 <vector> 100000 <vector> (parse-model)
] with-stream
[
over length # " vertices, " %
dup length # " triangles" %
] "" make print ;
100000 <vector> 100000 <vector> (parse-model) ;
: n ( vs triple -- n )
swap [ nth ] curry map
@ -41,7 +35,8 @@ IN: bunny.model
: read-model ( stream -- model )
"Reading model" print flush [
<file-reader> parse-model [ normals ] 2keep 3array
[ parse-model ] with-file-reader
[ normals ] 2keep 3array
] time ;
: model-path "bun_zipper.ply" ;

View File

@ -347,7 +347,7 @@ M: timestamp year. ( timestamp -- )
timestamp-second >fixnum write-00 ;
: timestamp>string ( timestamp -- str )
[ (timestamp>string) ] string-out ;
[ (timestamp>string) ] with-string-writer ;
: (write-gmt-offset) ( ratio -- )
1 /mod swap write-00 60 * write-00 ;
@ -366,7 +366,7 @@ M: timestamp year. ( timestamp -- )
dup (timestamp>string)
" " write
timestamp-gmt-offset write-gmt-offset
] string-out ;
] with-string-writer ;
: timestamp>http-string ( timestamp -- str )
#! http timestamp format
@ -382,7 +382,7 @@ M: timestamp year. ( timestamp -- )
timestamp-second >fixnum write-00 CHAR: Z write1 ;
: timestamp>rfc3339 ( timestamp -- str )
>gmt [ (timestamp>rfc3339) ] string-out ;
>gmt [ (timestamp>rfc3339) ] with-string-writer ;
: expect read1 assert= ;
@ -401,7 +401,7 @@ M: timestamp year. ( timestamp -- )
0 <timestamp> ;
: rfc3339>timestamp ( str -- timestamp )
[ (rfc3339>timestamp) ] string-in ;
[ (rfc3339>timestamp) ] with-string-reader ;
: file-time-string ( timestamp -- string )
[
@ -413,7 +413,7 @@ M: timestamp year. ( timestamp -- )
] [
timestamp-year number>string 5 32 pad-left write
] if
] string-out ;
] with-string-writer ;
: day-offset ( timestamp m -- timestamp n )
over day-of-week - ; inline

View File

@ -461,9 +461,9 @@ M: cpu reset ( cpu -- )
: load-rom ( filename cpu -- )
#! Load the contents of the file into ROM.
#! (address 0x0000-0x1FFF).
cpu-ram swap <file-reader> [
cpu-ram swap [
0 swap (load-rom)
] with-stream ;
] with-file-reader ;
SYMBOL: rom-root
@ -477,9 +477,9 @@ SYMBOL: rom-root
#! file path shoul dbe relative to the '/roms' resource path.
rom-dir [
cpu-ram [
swap first2 rom-dir swap path+ <file-reader> [
swap first2 rom-dir swap path+ [
swap (load-rom)
] with-stream
] with-file-reader
] curry each
] [
!

View File

@ -7,11 +7,11 @@ math.parser ;
IN: editors.jedit
: jedit-server-info ( -- port auth )
home "/.jedit/server" path+ <file-reader> [
home "/.jedit/server" path+ [
readln drop
readln string>number
readln string>number
] with-stream ;
] with-file-reader ;
: make-jedit-request ( files -- code )
[
@ -21,7 +21,7 @@ IN: editors.jedit
"new String[] {" write
[ pprint "," write ] each
"null});\n" write
] string-out ;
] with-string-writer ;
: send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <inet> <client> [

View File

@ -368,7 +368,7 @@ M: quotation fjsc-parse ( object -- ast )
(compile)
")" ,
] { } make [ write ] each
] string-out ;
] with-string-writer ;
: fjsc-compile* ( string -- string )
'statement' parse parse-result-ast fjsc-compile ;
@ -382,5 +382,5 @@ M: quotation fjsc-parse ( object -- ast )
: fjsc-literal ( ast -- string )
[
[ (literal) ] { } make [ write ] each
] string-out ;
] with-string-writer ;

View File

@ -59,17 +59,17 @@ TUPLE: bitmap magic size reserved offset header-length width
dup color-index-length read swap set-bitmap-color-index ;
: load-bitmap ( path -- bitmap )
<file-reader> [
[
T{ bitmap } clone
dup parse-file-header
dup parse-bitmap-header
dup parse-bitmap
] with-stream
] with-file-reader
dup bitmap-color-index over bitmap-bit-count
raw-bitmap>string >byte-array over set-bitmap-array ;
: save-bitmap ( bitmap path -- )
<file-writer> [
[
"BM" write
dup bitmap-array length 14 + 40 + 4 >le write
0 4 >le write
@ -88,7 +88,7 @@ TUPLE: bitmap magic size reserved offset header-length width
dup bitmap-color-important 4 >le write
dup bitmap-rgb-quads write
bitmap-color-index write
] with-stream ;
] with-file-writer ;
M: bitmap draw-image ( bitmap -- )
dup bitmap-height 0 < [

View File

@ -195,7 +195,7 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
}
"Read 1024 bytes from a file:"
{ $code
"\"data.bin\" <file-reader> [ 1024 read ] with-stream"
"\"data.bin\" [ 1024 read ] with-file-reader"
}
"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory:"
{ $code

View File

@ -69,7 +69,7 @@ IN: help.lint
] each ;
: check-rendering ( word element -- )
[ help ] string-out drop ;
[ help ] with-string-writer drop ;
: all-word-help ( words -- seq )
[ word-help ] subset ;

View File

@ -16,7 +16,7 @@ TUPLE: blahblah quux ;
test-slot blahblah $spec-reader-values
] unit-test
[ "an int" ] [ [ { "int" } $instance ] string-out ] unit-test
[ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
[ ] [ \ blahblah-quux help ] unit-test
[ ] [ \ set-blahblah-quux help ] unit-test

View File

@ -25,7 +25,7 @@ PRIVATE>
[
dup length header.
16 <sliced-groups> [ line. ] each-index
] string-out ;
] with-string-writer ;
: hexdump. ( seq -- )
hexdump write ;

View File

@ -2,7 +2,7 @@ IN: temporary
USING: tools.test html html.elements io.streams.string ;
: make-html-string
[ with-html-stream ] string-out ;
[ with-html-stream ] with-string-writer ;
[ "<a href='h&amp;o'>" ]
[ [ <a "h&o" =href a> ] make-html-string ] unit-test

View File

@ -3,7 +3,7 @@ namespaces tools.test xml.writer sbufs sequences html.private ;
IN: temporary
: make-html-string
[ with-html-stream ] string-out ;
[ with-html-stream ] with-string-writer ;
[ ] [
512 <sbuf> <html-stream> drop

View File

@ -6,7 +6,7 @@ IN: temporary
"extra/http/server/templating/test/" swap append
[
".fhtml" append resource-path
[ run-template-file ] string-out
[ run-template-file ] with-string-writer
] keep
".html" append resource-path file-contents = ;

View File

@ -93,4 +93,4 @@ DEFER: <% delimiter
swap path+ run-template-file ;
: template-convert ( infile outfile -- )
<file-writer> [ run-template-file ] with-stream ;
[ run-template-file ] with-file-writer ;

View File

@ -120,7 +120,7 @@ C: <extended-header> extended-header
id3v2? [ read-id3v2 ] [ f ] if ;
: id3v2 ( filename -- tag/f )
<file-reader> [ read-tag ] with-stream ;
[ read-tag ] with-file-reader ;
: file? ( path -- ? )
stat 3drop not ;
@ -135,7 +135,7 @@ C: <extended-header> extended-header
[ mp3? ] subset ;
: id3? ( file -- ? )
<file-reader> [ id3v2? ] with-stream ;
[ id3v2? ] with-file-reader ;
: id3s ( files -- id3s )
[ id3? ] subset ;

View File

@ -2,7 +2,7 @@ USING: io io.mmap io.files kernel tools.test continuations sequences ;
IN: temporary
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
[ ] [ "mmap-test-file.txt" resource-path <file-writer> [ "12345" write ] with-stream ] unit-test
[ ] [ "mmap-test-file.txt" resource-path [ "12345" write ] with-file-writer ] unit-test
[ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test

View File

@ -131,16 +131,16 @@ client-addr <datagram>
! Invalid parameter tests
[
image <file-reader> [ stdio get accept ] with-stream
image [ stdio get accept ] with-file-reader
] must-fail
[
image <file-reader> [ stdio get receive ] with-stream
image [ stdio get receive ] with-file-reader
] must-fail
[
image <file-reader> [
image [
B{ 1 2 } server-addr
stdio get send
] with-stream
] with-file-reader
] must-fail

View File

@ -10,7 +10,7 @@ GENERIC: json-print ( obj -- )
: >json ( obj -- string )
#! Returns a string representing the factor object in JSON format
[ json-print ] string-out ;
[ json-print ] with-string-writer ;
M: f json-print ( f -- )
drop "false" write ;

View File

@ -11,7 +11,7 @@ SYMBOL: insomniac-recipients
: ?analyze-log ( service word-names -- string/f )
>r log-path 1 log# dup exists? [
file-lines r> [ analyze-log ] string-out
file-lines r> [ analyze-log ] with-string-writer
] [
r> 2drop f
] if ;

View File

@ -103,7 +103,7 @@ PRIVATE>
: (log-error) ( object word level -- )
log-service get [
>r >r [ print-error ] string-out r> r> log-message
>r >r [ print-error ] with-string-writer r> r> log-message
] [
2drop rethrow
] if ;

View File

@ -13,6 +13,6 @@ IN: msxml-to-csv
] map ;
: msxml>csv ( infile outfile -- )
<file-writer> [
[
file>xml (msxml>csv) print-csv
] with-stream ;
] with-file-writer ;

View File

@ -41,7 +41,7 @@ USING: io io.streams.string kernel namespaces pack strings tools.test ;
<string-reader> [ "int" read-native ] with-stream
] unit-test
[ "FRAM" ] [ "FRAM\0" [ read-c-string ] string-in ] unit-test
[ f ] [ "" [ read-c-string ] string-in ] unit-test
[ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] string-in ] unit-test
[ "FRAM" ] [ "FRAM\0" [ read-c-string ] with-string-reader ] unit-test
[ f ] [ "" [ read-c-string ] with-string-reader ] unit-test
[ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] with-string-reader ] unit-test

View File

@ -27,6 +27,6 @@ MEMO: any-char-parser ( -- parser )
any-char-parser 2array choice repeat0 parse parse-result-ast [ ] subset ;
: replace ( string parser -- result )
[ (replace) [ tree-write ] each ] string-out ;
[ (replace) [ tree-write ] each ] with-string-writer ;

View File

@ -55,7 +55,7 @@ C: <entry> entry
[
{ "content" "summary" } any-tag-named
dup tag-children [ string? not ] contains?
[ tag-children [ write-chunk ] string-out ]
[ tag-children [ write-chunk ] with-string-writer ]
[ children>string ] if
] keep
{ "published" "updated" "issued" "modified" } any-tag-named

View File

@ -8,7 +8,7 @@ HELP: (serialize)
}
{ $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained. It must be called from within the scope of a " { $link with-serialized } " call." }
{ $examples
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] with-string-writer\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] with-string-reader eq? ." "t" }
}
{ $see-also deserialize (deserialize) serialize with-serialized } ;
@ -17,7 +17,7 @@ HELP: (deserialize)
}
{ $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained. It must be called from within the scope of a " { $link with-serialized } " call." }
{ $examples
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] with-string-writer\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] with-string-reader eq? ." "t" }
}
{ $see-also (serialize) deserialize serialize with-serialized } ;
@ -26,7 +26,7 @@ HELP: with-serialized
}
{ $description "Creates a scope for serialization and deserialization operations. The quotation is called within this scope. The scope is used for maintaining the structure and object references of serialized objects." }
{ $examples
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] with-string-writer\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] with-string-reader eq? ." "t" }
}
{ $see-also (serialize) (deserialize) serialize deserialize } ;
@ -35,7 +35,7 @@ HELP: serialize
}
{ $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained." }
{ $examples
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] with-string-writer\n\n[ deserialize ] with-string-reader ." "{ 1 2 }" }
}
{ $see-also deserialize (deserialize) (serialize) with-serialized } ;
@ -44,6 +44,6 @@ HELP: deserialize
}
{ $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained." }
{ $examples
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] with-string-writer\n\n[ deserialize ] with-string-reader ." "{ 1 2 }" }
}
{ $see-also (serialize) deserialize (deserialize) with-serialized } ;

View File

@ -38,8 +38,8 @@ C: <serialize-test> serialize-test
: check-serialize-1 ( obj -- ? )
dup class .
dup [ serialize ] string-out
[ deserialize ] string-in = ;
dup [ serialize ] with-string-writer
[ deserialize ] with-string-reader = ;
: check-serialize-2 ( obj -- ? )
dup number? over wrapper? or [
@ -47,8 +47,8 @@ C: <serialize-test> serialize-test
] [
dup class .
dup 2array
[ serialize ] string-out
[ deserialize ] string-in
[ serialize ] with-string-writer
[ deserialize ] with-string-reader
first2 eq?
] if ;
@ -63,7 +63,7 @@ C: <serialize-test> serialize-test
[
dup (serialize) (serialize)
] with-serialized
] string-out [
] with-string-writer [
deserialize-sequence all-eq?
] string-in
] with-string-reader
] unit-test

View File

@ -12,7 +12,7 @@ IN: temporary
[ { "hello" "." "world" } validate-message ] must-fail
[ "hello\r\nworld\r\n.\r\n" ] [
{ "hello" "world" } [ send-body ] string-out
{ "hello" "world" } [ send-body ] with-string-writer
] unit-test
[ "500 syntax error" check-response ] must-fail
@ -20,17 +20,17 @@ IN: temporary
[ ] [ "220 success" check-response ] unit-test
[ "220 success" ] [
"220 success" [ receive-response ] string-in
"220 success" [ receive-response ] with-string-reader
] unit-test
[ "220 the end" ] [
"220-a multiline response\r\n250-another line\r\n220 the end"
[ receive-response ] string-in
[ receive-response ] with-string-reader
] unit-test
[ ] [
"220-a multiline response\r\n250-another line\r\n220 the end"
[ get-ok ] string-in
[ get-ok ] with-string-reader
] unit-test
[

View File

@ -72,7 +72,7 @@ SYMBOL: filename
0 over set-tar-header-size
0 over set-tar-header-checksum
] [
[ read-tar-header ] string-in
[ read-tar-header ] with-string-reader
[ tar-header-checksum = [
\ checksum-error construct-empty throw
] unless
@ -241,4 +241,4 @@ TUPLE: unimplemented-typeflag header ;
global [ nl nl nl "Starting to parse .tar..." print flush ] bind
global [ "Expanding to: " write base-dir get . flush ] bind
(parse-tar)
] with-file-out ;
] with-file-writer ;

View File

@ -18,7 +18,7 @@ MEMO: (vocab-file-contents) ( path -- lines )
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-path+ [
?resource-path
[ [ print ] each ] with-file-out
[ [ print ] each ] with-file-writer
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"

View File

@ -20,7 +20,7 @@ M: pair make-disassemble-cmd
current-process-handle number>string print
"disassemble " write
[ number>string write bl ] each
] with-file-out ;
] with-file-writer ;
: run-gdb ( -- lines )
[

View File

@ -81,11 +81,11 @@ IN: temporary
] unit-test
[ { "hi\n" } ] [
[ [ "hi" print ] string-out ] test-interpreter
[ [ "hi" print ] with-string-writer ] test-interpreter
] unit-test
[ { "4\n" } ] [
[ [ 2 2 + number>string print ] string-out ] test-interpreter
[ [ 2 2 + number>string print ] with-string-writer ] test-interpreter
] unit-test
[ { 1 2 3 } ] [
@ -105,7 +105,7 @@ IN: temporary
[ [ [ 3 throw ] [ 2 * ] recover ] test-interpreter ] unit-test
[ { "{ 1 2 3 }\n" } ] [
[ [ { 1 2 3 } . ] string-out ] test-interpreter
[ [ { 1 2 3 } . ] with-string-writer ] test-interpreter
] unit-test
[ { } ] [

View File

@ -13,4 +13,4 @@ IN: tools.test.ui
swap slip
ungraft notify-queued
] with-variable
] string-out print ;
] with-string-writer print ;

View File

@ -27,5 +27,5 @@ testing "testing" "hey" {
[ "C+x" ] [
[
{ $command testing "testing" com-test-1 } print-element
] string-out
] with-string-writer
] unit-test

View File

@ -191,7 +191,7 @@ M: mock-gadget ungraft*
] with-variable ;
{ { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
] string-out print
] with-string-writer print
\ <gadget> must-infer
\ unparent must-infer

View File

@ -18,7 +18,7 @@ tools.test.ui models ;
: test-gadget-text
dup make-pane gadget-text
swap string-out "\n" ?tail drop "\n" ?tail drop = ;
swap with-string-writer "\n" ?tail drop "\n" ?tail drop = ;
[ t ] [ [ "hello" write ] test-gadget-text ] unit-test
[ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test

View File

@ -10,5 +10,5 @@ tuples ;
[ "+" ] [
[
\ + f \ pprint <command-button> dup button-quot call
] string-out
] with-string-writer
] unit-test

View File

@ -11,7 +11,7 @@ io.streams.string math help help.markup ;
3 "op" get operation-command command-quot
] unit-test
[ "3" ] [ [ 3 "op" get invoke-command ] string-out ] unit-test
[ "3" ] [ [ 3 "op" get invoke-command ] with-string-writer ] unit-test
[ drop t ] \ my-pprint [ ] [ editor-string ] f operation construct-boa
"op" set
@ -20,9 +20,9 @@ io.streams.string math help help.markup ;
[
"4" <editor> [ set-editor-string ] keep
"op" get invoke-command
] string-out
] with-string-writer
] unit-test
[ ] [
[ { $operations \ + } print-element ] string-out drop
[ { $operations \ + } print-element ] with-string-writer drop
] unit-test

View File

@ -1,3 +1,3 @@
USING: tools.test io.streams.string xml.generator xml.writer ;
[ "<html><body><a href=\"blah\"/></body></html>" ]
[ "html" [ "body" [ "a" { { "href" "blah" } } contained*, ] tag, ] make-xml [ write-item ] string-out ] unit-test
[ "html" [ "body" [ "a" { { "href" "blah" } } contained*, ] tag, ] make-xml [ write-item ] with-string-writer ] unit-test

View File

@ -108,7 +108,7 @@ M: instruction write-item
write-xml nl ;
: xml>string ( xml -- string )
[ write-xml ] string-out ;
[ write-xml ] with-string-writer ;
: with-xml-pprint ( sensitive-tags quot -- )
[

View File

@ -98,7 +98,7 @@ IN: factorbot-commands
] if ;
: memory ( text -- )
drop [ room. ] string-out multiline-respond ;
drop [ room. ] with-string-writer multiline-respond ;
: quit ( text -- )
drop speaker get "slava" = [ disconnect ] when ;

View File

@ -72,7 +72,7 @@ M: number tree-write ( char -- ) write1 ;
: farkup ( str -- html )
'farkup' parse dup nil?
[ error ] [ car parse-result-parsed [ tree-write ] string-out ] if ;
[ error ] [ car parse-result-parsed [ tree-write ] with-string-writer ] if ;
! useful debugging code below
@ -83,4 +83,4 @@ M: number tree-write ( char -- ) write1 ;
: farkup-parsed ( wiki -- all-parses )
! for debugging and optimization only
'farkup' parse list>array
[ parse-result-parsed [ tree-write ] string-out ] map ;
[ parse-result-parsed [ tree-write ] with-string-writer ] map ;

View File

@ -148,13 +148,13 @@ DEFER: name>user
[ httpd ] in-thread drop ;
: onigiri-dump ( path -- )
<file-writer> [
[
[
entry get-global serialize
meta get-global serialize
user get-global serialize
] with-serialized
] with-stream ;
] with-file-writer ;
: onigiri-boot ( path -- )
<file-reader> [

View File

@ -4,9 +4,9 @@ IN: temporary
SYMBOL: mmap "mmap-test.txt" \ mmap set
[ \ mmap get delete-file ] catch drop
\ mmap get <file-writer> [
\ mmap get [
"Four" write
] with-stream
] with-file-writer
\ mmap get [
>r CHAR: R r> mmap-address 3 set-alien-unsigned-1