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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/alien/compiler/compiler-tests.factor
View File

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

2
core/bootstrap/image/image.factor
View File

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

2
core/classes/classes-tests.factor
View File

@ -63,7 +63,7 @@ UNION: bah fixnum alien ;
! Test generic see and parsing ! Test generic see and parsing
[ "USING: alien math ;\nIN: temporary\nUNION: bah fixnum alien ;\n" ] [ "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 ! Test redefinition of classes
UNION: union-1 fixnum float ; UNION: union-1 fixnum float ;

2
core/inspector/inspector-tests.factor
View File

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

4
core/io/files/files-docs.factor
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." } { $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." } ; { $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" } } { $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." } { $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file is unreadable." } ; { $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" } } { $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for writing and calls the quotation using " { $link with-stream } "." } { $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." } ; { $errors "Throws an error if the file cannot be opened for writing." } ;

8
core/io/files/files-tests.factor
View File

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

13
core/io/files/files.factor
View File

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

4
core/io/io-tests.factor
View File

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

4
core/io/streams/c/c-tests.factor
View File

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

8
core/io/streams/string/string-docs.factor
View File

@ -6,8 +6,8 @@ ARTICLE: "io.streams.string" "String streams"
{ $subsection <string-reader> } { $subsection <string-reader> }
{ $subsection <string-writer> } { $subsection <string-writer> }
"Utility combinators:" "Utility combinators:"
{ $subsection string-in } { $subsection with-string-reader }
{ $subsection string-out } ; { $subsection with-string-writer } ;
ABOUT: "io.streams.string" ABOUT: "io.streams.string"
@ -15,7 +15,7 @@ HELP: <string-writer>
{ $values { "stream" "an output stream" } } { $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." } ; { $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 } } { $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." } ; { $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." } { $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." } ; { $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 } } { $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." } ; { $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." } ;

2
core/io/streams/string/string-tests.factor
View File

@ -12,7 +12,7 @@ unit-test
[ "" <string-reader> stream-readln ] [ "" <string-reader> stream-readln ]
unit-test 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 [ "a" ] [ 1 SBUF" cba" stream-read ] unit-test
[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test [ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test

4
core/io/streams/string/string.factor
View File

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

6
core/kernel/kernel-tests.factor
View File

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

2
core/parser/parser.factor
View File

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

12
core/prettyprint/prettyprint-tests.factor
View File

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

6
core/prettyprint/prettyprint.factor
View File

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

2
extra/asn1/asn1.factor
View File

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

2
extra/benchmark/fasta/fasta.factor
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 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 n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
drop drop
] with-file-out ] with-file-writer
] with-locals ; ] with-locals ;

3
extra/benchmark/knucleotide/knucleotide.factor
View File

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

4
extra/benchmark/mandel/mandel.factor
View File

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

2
extra/benchmark/raytracer/raytracer.factor
View File

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

2
extra/benchmark/sum-file/sum-file.factor
View File

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

2
extra/bootstrap/image/upload/upload.factor
View File

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

6
extra/builder/builder.factor
View File

@ -48,7 +48,7 @@ VAR: stamp
: git-id ( -- id ) : git-id ( -- id )
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second ; { "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" } ; : make-clean ( -- desc ) { "make" "clean" } ;
@ -132,9 +132,9 @@ SYMBOL: build-status
"Did not pass test-all: " print "../test-all-vocabs" cat "Did not pass test-all: " print "../test-all-vocabs" cat
"Benchmarks: " print "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 ; build-status on ;

12
extra/builder/test/test.factor
View File

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

2
extra/builder/util/util.factor
View File

@ -14,7 +14,7 @@ IN: builder.util
: minutes>ms ( min -- ms ) 60 * 1000 * ; : 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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

11
extra/bunny/model/model.factor
View File

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

10
extra/calendar/calendar.factor
View File

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

8
extra/cpu/8080/emulator/emulator.factor
View File

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

6
extra/editors/jedit/jedit.factor
View File

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

4
extra/fjsc/fjsc.factor
View File

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

8
extra/graphics/bitmap/bitmap.factor
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 ; dup color-index-length read swap set-bitmap-color-index ;
: load-bitmap ( path -- bitmap ) : load-bitmap ( path -- bitmap )
<file-reader> [ [
T{ bitmap } clone T{ bitmap } clone
dup parse-file-header dup parse-file-header
dup parse-bitmap-header dup parse-bitmap-header
dup parse-bitmap dup parse-bitmap
] with-stream ] with-file-reader
dup bitmap-color-index over bitmap-bit-count dup bitmap-color-index over bitmap-bit-count
raw-bitmap>string >byte-array over set-bitmap-array ; raw-bitmap>string >byte-array over set-bitmap-array ;
: save-bitmap ( bitmap path -- ) : save-bitmap ( bitmap path -- )
<file-writer> [ [
"BM" write "BM" write
dup bitmap-array length 14 + 40 + 4 >le write dup bitmap-array length 14 + 40 + 4 >le write
0 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-color-important 4 >le write
dup bitmap-rgb-quads write dup bitmap-rgb-quads write
bitmap-color-index write bitmap-color-index write
] with-stream ; ] with-file-writer ;
M: bitmap draw-image ( bitmap -- ) M: bitmap draw-image ( bitmap -- )
dup bitmap-height 0 < [ dup bitmap-height 0 < [

2
extra/help/cookbook/cookbook.factor
View File

@ -195,7 +195,7 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
} }
"Read 1024 bytes from a file:" "Read 1024 bytes from a file:"
{ $code { $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:" "Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory:"
{ $code { $code

2
extra/help/lint/lint.factor
View File

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

2
extra/help/markup/markup-tests.factor
View File

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

2
extra/hexdump/hexdump.factor
View File

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

2
extra/html/elements/elements-tests.factor
View File

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

2
extra/html/html-tests.factor
View File

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

2
extra/http/server/templating/templating-tests.factor
View File

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

2
extra/http/server/templating/templating.factor
View File

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

4
extra/id3/id3.factor
View File

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

2
extra/io/mmap/mmap-tests.factor
View File

@ -2,7 +2,7 @@ USING: io io.mmap io.files kernel tools.test continuations sequences ;
IN: temporary IN: temporary
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors [ "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 [ ] [ "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 [ 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 [ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test

8
extra/io/unix/unix-tests.factor
View File

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

2
extra/json/writer/writer.factor
View File

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

2
extra/logging/insomniac/insomniac.factor
View File

@ -11,7 +11,7 @@ SYMBOL: insomniac-recipients
: ?analyze-log ( service word-names -- string/f ) : ?analyze-log ( service word-names -- string/f )
>r log-path 1 log# dup exists? [ >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 r> 2drop f
] if ; ] if ;

2
extra/logging/logging.factor
View File

@ -103,7 +103,7 @@ PRIVATE>
: (log-error) ( object word level -- ) : (log-error) ( object word level -- )
log-service get [ 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 2drop rethrow
] if ; ] if ;

4
extra/msxml-to-csv/msxml-to-csv.factor
View File

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

6
extra/pack/pack-tests.factor
View File

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

2
extra/peg/search/search.factor
View File

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

2
extra/rss/rss.factor
View File

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

10
extra/serialize/serialize-docs.factor
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." } { $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 { $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 } ; { $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." } { $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 { $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 } ; { $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." } { $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 { $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 } ; { $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." } { $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained." }
{ $examples { $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 } ; { $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." } { $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained." }
{ $examples { $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 } ; { $see-also (serialize) deserialize (deserialize) with-serialized } ;

12
extra/serialize/serialize-tests.factor
View File

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

8
extra/smtp/smtp-tests.factor
View File

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

4
extra/tar/tar.factor
View File

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

2
extra/tools/browser/browser.factor
View File

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

2
extra/tools/disassembler/disassembler.factor
View File

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

6
extra/tools/interpreter/interpreter-tests.factor
View File

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

2
extra/tools/test/ui/ui.factor
View File

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

2
extra/ui/commands/commands-tests.factor
View File

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

2
extra/ui/gadgets/gadgets-tests.factor
View File

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

2
extra/ui/gadgets/panes/panes-tests.factor
View File

@ -18,7 +18,7 @@ tools.test.ui models ;
: test-gadget-text : test-gadget-text
dup make-pane 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" write ] test-gadget-text ] unit-test
[ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test [ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test

2
extra/ui/gadgets/presentations/presentations-tests.factor
View File

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

6
extra/ui/operations/operations-tests.factor
View File

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

2
extra/xml/generator/generator-tests.factor
View File

@ -1,3 +1,3 @@
USING: tools.test io.streams.string xml.generator xml.writer ; USING: tools.test io.streams.string xml.generator xml.writer ;
[ "<html><body><a href=\"blah\"/></body></html>" ] [ "<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

2
extra/xml/writer/writer.factor
View File

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

2
unmaintained/factorbot.factor
View File

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

4
unmaintained/farkup/farkup.factor
View File

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

4
unmaintained/furnace-onigiri/onigiri.factor
View File

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

4
unmaintained/io/test/mmap.factor
View File

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