diff --git a/core/alien/compiler/compiler-tests.factor b/core/alien/compiler/compiler-tests.factor index c0c3733afa..876310cc5d 100755 --- a/core/alien/compiler/compiler-tests.factor +++ b/core/alien/compiler/compiler-tests.factor @@ -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 diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 7c12b3ea60..17b56458ce 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -416,7 +416,7 @@ M: curry ' "Writing image to " write architecture get boot-image-name resource-path dup write "..." print flush - [ (write-image) ] with-stream ; + [ (write-image) ] with-file-writer ; PRIVATE> diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index c7024a7490..103c4eed09 100755 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -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 ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 53f47c09d5..45de3be97f 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -30,6 +30,7 @@ M: generic definer drop f f ; M: generic definition drop f ; : make-generic ( word -- ) + dup { "unannotated-def" } reset-props dup dup "combination" word-prop perform-combination define ; TUPLE: method word def specializer generic loc ; diff --git a/core/inspector/inspector-tests.factor b/core/inspector/inspector-tests.factor index 4cb638c3de..fce0cc0c86 100644 --- a/core/inspector/inspector-tests.factor +++ b/core/inspector/inspector-tests.factor @@ -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 diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index b58f9836c0..c4c6237715 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1,6 +1,3 @@ USING: kernel io.encodings ; TUPLE: binary ; - -M: binary init-decoding drop ; -M: binary init-encoding drop ; diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 94a5bf8853..2d94e3ea80 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -53,27 +53,17 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) >r swap start-decoding r> decode-read-loop ; -GENERIC: init-decoding ( stream encoding -- decoded-stream ) - : ( stream decoding-class -- decoded-stream ) - construct-empty init-decoding ; - -GENERIC: init-encoding ( stream encoding -- encoded-stream ) + construct-delegate ; : ( stream encoding-class -- encoded-stream ) - construct-empty init-encoding ; + construct-delegate ; GENERIC: encode-string ( string encoding -- byte-array ) M: tuple-class encode-string construct-empty encode-string ; MIXIN: encoding-stream -M: encoding-stream init-decoding ( stream encoding-stream -- encoding-stream ) - tuck set-delegate ; - -M: encoding-stream init-encoding ( stream encoding-stream -- encoding-stream ) - tuck set-delegate ; - M: encoding-stream stream-read1 1 swap stream-read ; M: encoding-stream stream-read @@ -93,3 +83,13 @@ M: encoding-stream stream-write [ encode-string ] keep delegate stream-write ; M: encoding-stream dispose delegate dispose ; + +GENERIC: underlying-stream ( encoded-stream -- delegate ) +M: encoding-stream underlying-stream delegate ; + +GENERIC: set-underlying-stream ( new-underlying stream -- ) +M: encoding-stream set-underlying-stream set-delegate ; + +: set-encoding ( encoding stream -- ) ! This doesn't work now + [ underlying-stream swap construct-delegate ] keep + set-underlying-stream ; diff --git a/core/io/encodings/latin1/latin1.factor b/core/io/encodings/latin1/latin1.factor index 468324316d..e6d6281eb6 100755 --- a/core/io/encodings/latin1/latin1.factor +++ b/core/io/encodings/latin1/latin1.factor @@ -1,19 +1,10 @@ USING: io io.encodings strings kernel ; IN: io.encodings.latin1 -TUPLE: latin1 stream ; +TUPLE: latin1 ; -M: latin1 init-decoding tuck set-latin1-stream ; -M: latin1 init-encoding drop ; +M: latin1 stream-read delegate stream-read >string ; -M: latin1 stream-read1 - latin1-stream stream-read1 ; +M: latin1 stream-read-until delegate stream-read-until >string ; -M: latin1 stream-read - latin1-stream stream-read >string ; - -M: latin1 stream-read-until - latin1-stream stream-read-until >string ; - -M: latin1 stream-readln - latin1-stream stream-readln >string ; +M: latin1 stream-read-partial delegate stream-read-partial >string ; diff --git a/core/io/encodings/utf16/utf16-tests.factor b/core/io/encodings/utf16/utf16-tests.factor index d1817db1e8..041c486915 100755 --- a/core/io/encodings/utf16/utf16-tests.factor +++ b/core/io/encodings/utf16/utf16-tests.factor @@ -1,15 +1,28 @@ -USING: tools.test io.utf16 arrays unicode ; +USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings +io unicode ; -[ { CHAR: x } ] [ { 0 CHAR: x } decode-utf16be >array ] unit-test -[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } decode-utf16be >array ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } decode-utf16be >array ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } decode-utf16be >array ] unit-test +: decode-w/stream ( array encoding -- newarray ) + >r >sbuf dup reverse-here r> contents >array ; -[ B{ 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } encode-utf16be ] unit-test +: encode-w/stream ( array encoding -- newarray ) + >r SBUF" " clone tuck r> stream-write >array ; -[ { CHAR: x } ] [ { CHAR: x 0 } decode-utf16le >array ] unit-test -[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } decode-utf16le >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } decode-utf16le >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } decode-utf16le >array ] unit-test +[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode-w/stream ] unit-test +[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode-w/stream ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode-w/stream ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode-w/stream ] unit-test -[ B{ 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } encode-utf16le ] unit-test +[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test + +[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode-w/stream ] unit-test +[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode-w/stream ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode-w/stream ] unit-test +[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test + +[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode-w/stream ] unit-test + +[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode-w/stream ] unit-test +[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode-w/stream ] unit-test + +[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode-w/stream ] unit-test diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 84017324ee..35b6282e21 100755 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces io.binary -io.encodings combinators splitting ; +io.encodings combinators splitting io byte-arrays ; IN: io.encodings.utf16 SYMBOL: double @@ -104,23 +104,49 @@ SYMBOL: ignore : encode-utf16 ( str -- seq ) encode-utf16le bom-le swap append ; +: start-utf16le? ( seq1 -- seq2 ? ) bom-le ?head ; + +: start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ; + : decode-utf16 ( seq -- str ) { - { [ bom-le ?head ] [ decode-utf16le ] } - { [ bom-be ?head ] [ decode-utf16be ] } + { [ start-utf16le? ] [ decode-utf16le ] } + { [ start-utf16be? ] [ decode-utf16be ] } { [ t ] [ decode-error ] } } cond ; TUPLE: utf16le ; -: utf16le construct-delegate ; INSTANCE: utf16le encoding-stream M: utf16le encode-string drop encode-utf16le ; M: utf16le decode-step drop decode-utf16le-step ; TUPLE: utf16be ; -: utf16be construct-delegate ; INSTANCE: utf16be encoding-stream M: utf16be encode-string drop encode-utf16be ; M: utf16be decode-step drop decode-utf16be-step ; + +TUPLE: utf16 encoding ; +INSTANCE: utf16 encoding-stream +M: utf16 underlying-stream delegate dup delegate [ ] [ ] ?if ; ! necessary? +M: utf16 set-underlying-stream delegate set-delegate ; ! necessary? + +M: utf16 encode-string + >r encode-utf16le r> + dup utf16-encoding [ drop ] + [ t swap set-utf16-encoding bom-le swap append ] if ; + +: bom>le/be ( bom -- le/be ) + dup bom-le sequence= [ drop utf16le ] [ + bom-be sequence= [ utf16be ] [ decode-error ] if + ] if ; + +: read-bom ( utf16 -- encoding ) + 2 over delegate stream-read bom>le/be construct-empty + [ swap set-utf16-encoding ] keep ; + +M: utf16 decode-step + ! inefficient: checks if bom is done many times + ! This should transform itself into utf16be or utf16le after reading BOM + dup utf16-encoding [ ] [ read-bom ] ?if decode-step ; diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index ea7a238551..44d0870385 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -1,11 +1,11 @@ -USING: io.encodings.utf8 tools.test sbufs kernel io +USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings sequences strings arrays unicode ; : decode-utf8-w/stream ( array -- newarray ) - >sbuf dup reverse-here contents >array ; + >sbuf dup reverse-here utf8 contents ; : encode-utf8-w/stream ( array -- newarray ) - SBUF" " clone tuck write >array ; + SBUF" " clone tuck utf8 stream-write >array ; [ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test @@ -19,5 +19,5 @@ sequences strings arrays unicode ; [ { BIN: 1111000000111111 } ] [ { BIN: 11101111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream >array ] unit-test -[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ] -[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } encode-utf8 ] unit-test +[ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ] +[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } encode-utf8-w/stream ] unit-test diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index f681b18142..6a3a8b8ec7 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -78,7 +78,6 @@ SYMBOL: quad3 ! Interface for streams TUPLE: utf8 ; -: utf8 construct-delegate ; INSTANCE: utf8 encoding-stream M: utf8 encode-string drop encode-utf8 ; diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 99f2d42542..185fa1436b 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -52,12 +52,12 @@ HELP: { $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." } ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index bac9a2e65e..d0f9737f19 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -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 [ + "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 [ [ 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 [ [ 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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 9afe9362cf..1824a47867 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ IN: io.files USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions -system combinators splitting sbufs ; +system combinators splitting sbufs continuations ; HOOK: cd io-backend ( path -- ) @@ -116,11 +116,10 @@ HOOK: copy-file io-backend ( from to -- ) M: object copy-file dup parent-directory make-directories [ - stdio get swap - [ - stdio get swap stream-copy - ] with-stream - ] with-stream ; + swap [ + swap stream-copy + ] with-disposal + ] with-disposal ; : copy-directory ( from to -- ) dup make-directories @@ -144,12 +143,13 @@ M: pathname <=> [ pathname-string ] compare ; : file-lines ( path -- seq ) lines ; : file-contents ( path -- str ) - dup swap file-length [ stream-copy ] keep >string ; + dup swap file-length + [ stream-copy ] keep >string ; -: with-file-in ( path quot -- ) +: with-file-reader ( path quot -- ) >r r> with-stream ; inline -: with-file-out ( path quot -- ) +: with-file-writer ( path quot -- ) >r r> with-stream ; inline : with-file-appender ( path quot -- ) diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index ab1d00ea3d..23686abab5 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -53,7 +53,7 @@ IN: temporary ] unit-test [ ] [ - image [ + image [ 10 [ 65536 read drop ] times - ] with-stream + ] with-file-reader ] unit-test diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor new file mode 100644 index 0000000000..77a9126740 --- /dev/null +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -0,0 +1,9 @@ +USING: tools.test io.streams.byte-array io.encodings.binary +io.encodings.utf8 io kernel arrays strings ; + +[ B{ 1 2 3 } ] [ binary [ { 1 2 3 } write ] with-byte-writer ] unit-test +[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test + +[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ] +[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } utf8 [ write ] with-byte-writer ] unit-test +[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 contents dup >array swap string? ] unit-test diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor new file mode 100644 index 0000000000..eb224650f3 --- /dev/null +++ b/core/io/streams/byte-array/byte-array.factor @@ -0,0 +1,16 @@ +USING: byte-arrays byte-vectors kernel io.encodings io.streams.string +sequences io namespaces ; +IN: io.streams.byte-array + +: ( encoding -- stream ) + 512 swap ; + +: with-byte-writer ( encoding quot -- byte-array ) + >r r> [ stdio get ] compose with-stream* + >byte-array ; inline + +: ( byte-array encoding -- stream ) + >r >byte-vector dup reverse-here r> ; + +: with-byte-reader ( byte-array encoding quot -- ) + >r r> with-stream ; inline diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 74a17ffc4c..5ace929ceb 100755 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -2,9 +2,9 @@ USING: tools.test io.files io io.streams.c ; IN: temporary [ "hello world" ] [ - "test.txt" resource-path [ + "test.txt" resource-path [ "hello world" write - ] with-stream + ] with-file-writer "test.txt" resource-path "rb" fopen contents ] unit-test diff --git a/core/io/streams/string/string-docs.factor b/core/io/streams/string/string-docs.factor index 45238c8c31..e948d2162a 100644 --- a/core/io/streams/string/string-docs.factor +++ b/core/io/streams/string/string-docs.factor @@ -6,8 +6,8 @@ ARTICLE: "io.streams.string" "String streams" { $subsection } { $subsection } "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: { $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: { $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." } ; diff --git a/core/io/streams/string/string-tests.factor b/core/io/streams/string/string-tests.factor index 9c8202afaf..4bd31fe7d8 100644 --- a/core/io/streams/string/string-tests.factor +++ b/core/io/streams/string/string-tests.factor @@ -12,7 +12,7 @@ unit-test [ "" 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 diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index 3d5a55739b..a45c616b9a 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -2,21 +2,21 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.streams.string USING: io kernel math namespaces sequences sbufs strings -generic splitting io.streams.plain io.streams.lines +generic splitting io.streams.plain io.streams.lines growable continuations ; -M: sbuf dispose drop ; +M: growable dispose drop ; -M: sbuf stream-write1 push ; -M: sbuf stream-write push-all ; -M: sbuf stream-flush drop ; +M: growable stream-write1 push ; +M: growable stream-write push-all ; +M: growable stream-flush drop ; : ( -- stream ) 512 ; -: string-out ( quot -- str ) - [ call stdio get >string ] with-stream* ; - inline +: with-string-writer ( quot -- str ) + swap [ stdio get ] compose with-stream* + >string ; inline : format-column ( seq ? -- seq ) [ @@ -37,36 +37,39 @@ M: plain-writer stream-write-table M: plain-writer make-cell-stream 2drop ; -M: sbuf stream-read1 dup empty? [ drop f ] [ pop ] if ; +M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ; -: sbuf-read-until ( sbuf n -- str ) - tail-slice >string dup reverse-here ; +: harden-as ( seq growble-exemplar -- newseq ) + underlying like ; + +: growable-read-until ( growable n -- str ) + dupd tail-slice swap harden-as dup reverse-here ; : find-last-sep swap [ memq? ] curry find-last drop ; -M: sbuf stream-read-until +M: growable stream-read-until [ find-last-sep ] keep over [ - [ swap 1+ sbuf-read-until ] 2keep [ nth ] 2keep + [ swap 1+ growable-read-until ] 2keep [ nth ] 2keep set-length ] [ - [ swap drop 0 sbuf-read-until f like f ] keep + [ swap drop 0 growable-read-until f like f ] keep delete-all ] if ; -M: sbuf stream-read +M: growable stream-read dup empty? [ 2drop f ] [ [ length swap - 0 max ] keep - [ swap sbuf-read-until ] 2keep + [ swap growable-read-until ] 2keep set-length ] if ; -M: sbuf stream-read-partial +M: growable stream-read-partial stream-read ; : ( str -- stream ) >sbuf dup reverse-here ; -: string-in ( str quot -- ) +: with-string-reader ( str quot -- ) >r r> with-stream ; inline diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index e37b208ef0..2972cb2d5d 100755 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -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 diff --git a/core/parser/parser.factor b/core/parser/parser.factor index c84c836390..fc29445f88 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -513,4 +513,4 @@ SYMBOL: interactive-vocabs [ parser-notes off [ [ eval ] keep ] try drop - ] string-out ; + ] with-string-writer ; diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor index a7e087ffad..11a685d581 100755 --- a/core/prettyprint/prettyprint-tests.factor +++ b/core/prettyprint/prettyprint-tests.factor @@ -67,19 +67,19 @@ unit-test [ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test [ t ] [ - 100 \ dup [ pprint-short ] string-out + 100 \ dup [ 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 [ [ + ] ] [ diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index ed52f0238c..2d4e6ced14 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -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 -- ) diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index 8b44c20479..99d1e0a19d 100644 --- a/extra/asn1/asn1.factor +++ b/extra/asn1/asn1.factor @@ -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 ) diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 280bc365a2..75321def2d 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -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 ; diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index ad1ffc1c50..b95e182bd1 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -57,8 +57,7 @@ IN: benchmark.knucleotide : knucleotide ( -- ) "extra/benchmark/knucleotide/knucleotide-input.txt" resource-path - - [ read-input ] with-stream + [ read-input ] with-file-reader process-input ; MAIN: knucleotide diff --git a/extra/benchmark/mandel/mandel.factor b/extra/benchmark/mandel/mandel.factor index 4aacadff23..230fb2f889 100755 --- a/extra/benchmark/mandel/mandel.factor +++ b/extra/benchmark/mandel/mandel.factor @@ -65,7 +65,7 @@ SYMBOL: cols ] with-scope ; : mandel-main ( -- ) - "mandel.ppm" resource-path - [ mandel write ] with-stream ; + "mandel.ppm" resource-path + [ mandel write ] with-file-writer ; MAIN: mandel-main diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 127392d237..8f2badc95f 100644 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -171,6 +171,6 @@ DEFER: create ( level c r -- scene ) : raytracer-main "raytracer.pnm" resource-path - [ run write ] with-stream ; + [ run write ] with-file-writer ; MAIN: raytracer-main diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index d509803896..0771b756bf 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -hints unicode.case ; +hints unicode.case continuations ; IN: benchmark.reverse-complement MEMO: trans-map ( -- str ) diff --git a/extra/benchmark/sum-file/sum-file.factor b/extra/benchmark/sum-file/sum-file.factor index 14166feb5b..e17765d542 100644 --- a/extra/benchmark/sum-file/sum-file.factor +++ b/extra/benchmark/sum-file/sum-file.factor @@ -5,7 +5,7 @@ IN: benchmark.sum-file readln [ string>number + sum-file-loop ] when* ; : sum-file ( file -- ) - [ 0 sum-file-loop ] with-stream . ; + [ 0 sum-file-loop ] with-file-reader . ; : sum-file-main ( -- ) home "sum-file-in.txt" path+ sum-file ; diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 3b5ab4cb77..552e26ebf5 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -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 ( -- ) [ diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index cd17a32255..0c9f4ab099 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,11 +1,7 @@ -USING: kernel parser io io.files io.launcher io.sockets hashtables math threads - arrays system continuations namespaces sequences splitting math.parser - prettyprint tools.time calendar bake vars http.client - combinators bootstrap.image bootstrap.image.download - combinators.cleave benchmark - classes strings quotations words parser-combinators new-slots accessors - assocs.lib smtp builder.util ; +USING: kernel namespaces sequences splitting system combinators continuations + parser io io.files io.launcher io.sockets prettyprint threads + bootstrap.image benchmark vars bake smtp builder.util accessors ; IN: builder @@ -48,7 +44,7 @@ VAR: stamp : git-id ( -- id ) { "git" "show" } [ 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 +128,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 ; diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index 7412dd9b36..c664941132 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -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 \ No newline at end of file diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index f9f432a8f6..f9eb17c565 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -3,8 +3,8 @@ USING: kernel words namespaces classes parser continuations io io.files io.launcher io.sockets math math.parser combinators sequences splitting quotations arrays strings tools.time - parser-combinators accessors assocs.lib - combinators.cleave bake calendar new-slots ; + parser-combinators new-slots accessors assocs.lib + combinators.cleave bake calendar ; IN: builder.util @@ -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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 4da6a5e379..7c77ed98af 100644 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -18,13 +18,7 @@ IN: bunny.model ] when* ; : parse-model ( stream -- vs is ) - [ - 100000 100000 (parse-model) - ] with-stream - [ - over length # " vertices, " % - dup length # " triangles" % - ] "" make print ; + 100000 100000 (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 [ - parse-model [ normals ] 2keep 3array + [ parse-model ] with-file-reader + [ normals ] 2keep 3array ] time ; : model-path "bun_zipper.ply" ; diff --git a/extra/calendar/calendar-tests.factor b/extra/calendar/calendar-tests.factor old mode 100644 new mode 100755 index 3b0cfc8455..a3ae5f115a --- a/extra/calendar/calendar-tests.factor +++ b/extra/calendar/calendar-tests.factor @@ -1,5 +1,5 @@ USING: arrays calendar kernel math sequences tools.test -continuations system ; +continuations system io.streams.string ; [ 2004 12 32 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with [ 2004 2 30 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with @@ -141,3 +141,23 @@ continuations system ; [ t ] [ 0 unix-time>timestamp unix-1970 = ] unit-test [ t ] [ 123456789 [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test [ t ] [ 123456789123456789 [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test + +[ 0 ] [ + "Z" [ read-rfc3339-gmt-offset ] with-string-reader +] unit-test + +[ 1 ] [ + "+01" [ read-rfc3339-gmt-offset ] with-string-reader +] unit-test + +[ -1 ] [ + "-01" [ read-rfc3339-gmt-offset ] with-string-reader +] unit-test + +[ -1-1/2 ] [ + "-01:30" [ read-rfc3339-gmt-offset ] with-string-reader +] unit-test + +[ 1+1/2 ] [ + "+01:30" [ read-rfc3339-gmt-offset ] with-string-reader +] unit-test diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 012080d3b7..5b89d6e8c5 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -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,42 +366,63 @@ 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 #! Example: Tue, 15 Nov 1994 08:12:31 GMT >gmt timestamp>rfc822-string ; +: write-rfc3339-gmt-offset ( n -- ) + dup zero? [ drop "Z" write ] [ + dup 0 < [ CHAR: - write1 neg ] [ CHAR: + write1 ] if + 60 * 60 /mod swap write-00 CHAR: : write1 write-00 + ] if ; + : (timestamp>rfc3339) ( timestamp -- ) dup timestamp-year number>string write CHAR: - write1 dup timestamp-month write-00 CHAR: - write1 dup timestamp-day write-00 CHAR: T write1 dup timestamp-hour write-00 CHAR: : write1 dup timestamp-minute write-00 CHAR: : write1 - timestamp-second >fixnum write-00 CHAR: Z write1 ; + dup timestamp-second >fixnum write-00 + timestamp-gmt-offset write-rfc3339-gmt-offset ; : timestamp>rfc3339 ( timestamp -- str ) - >gmt [ (timestamp>rfc3339) ] string-out ; + [ (timestamp>rfc3339) ] with-string-writer ; -: expect read1 assert= ; +: expect ( str -- ) + read1 swap member? [ "Parse error" throw ] unless ; + +: read-00 2 read string>number ; + +: read-0000 4 read string>number ; + +: read-rfc3339-gmt-offset ( -- n ) + read1 dup CHAR: Z = [ drop 0 ] [ + { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case + read-00 + read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case + 60 / + * + ] if ; : (rfc3339>timestamp) ( -- timestamp ) - 4 read string>number ! year - CHAR: - expect - 2 read string>number ! month - CHAR: - expect - 2 read string>number ! day - CHAR: T expect - 2 read string>number ! hour - CHAR: : expect - 2 read string>number ! minute - CHAR: : expect - 2 read string>number ! second - 0 ; + read-0000 ! year + "-" expect + read-00 ! month + "-" expect + read-00 ! day + "Tt" expect + read-00 ! hour + ":" expect + read-00 ! minute + ":" expect + read-00 ! second + read-rfc3339-gmt-offset ! timezone + ; : rfc3339>timestamp ( str -- timestamp ) - [ (rfc3339>timestamp) ] string-in ; + [ (rfc3339>timestamp) ] with-string-reader ; : file-time-string ( timestamp -- string ) [ @@ -413,7 +434,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 diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 310e387bd5..9499ff8dff 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -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 [ + 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+ [ + swap first2 rom-dir swap path+ [ swap (load-rom) - ] with-stream + ] with-file-reader ] curry each ] [ ! diff --git a/extra/editors/jedit/jedit.factor b/extra/editors/jedit/jedit.factor index a3a2446836..fd5b6c1b06 100644 --- a/extra/editors/jedit/jedit.factor +++ b/extra/editors/jedit/jedit.factor @@ -7,11 +7,11 @@ math.parser ; IN: editors.jedit : jedit-server-info ( -- port auth ) - home "/.jedit/server" path+ [ + 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 [ diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor index 3821ac46b3..5b5900f0bc 100755 --- a/extra/fjsc/fjsc.factor +++ b/extra/fjsc/fjsc.factor @@ -365,7 +365,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 ; @@ -379,5 +379,5 @@ M: quotation fjsc-parse ( object -- ast ) : fjsc-literal ( ast -- string ) [ [ (literal) ] { } make [ write ] each - ] string-out ; + ] with-string-writer ; diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 9539d9ecc1..8e61766de1 100644 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -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 ) - [ + [ 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 -- ) - [ + [ "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 < [ diff --git a/extra/help/cookbook/cookbook.factor b/extra/help/cookbook/cookbook.factor index 654f863fd6..5be69663f8 100755 --- a/extra/help/cookbook/cookbook.factor +++ b/extra/help/cookbook/cookbook.factor @@ -195,7 +195,7 @@ ARTICLE: "cookbook-io" "Input and output cookbook" } "Read 1024 bytes from a file:" { $code - "\"data.bin\" [ 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 diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index 6496ca21ff..3c11a93509 100644 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -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 ; diff --git a/extra/help/markup/markup-tests.factor b/extra/help/markup/markup-tests.factor index f8675bec8c..71a9b54760 100644 --- a/extra/help/markup/markup-tests.factor +++ b/extra/help/markup/markup-tests.factor @@ -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 diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index 3aaf464355..468a8cf253 100644 --- a/extra/hexdump/hexdump.factor +++ b/extra/hexdump/hexdump.factor @@ -25,7 +25,7 @@ PRIVATE> [ dup length header. 16 [ line. ] each-index - ] string-out ; + ] with-string-writer ; : hexdump. ( seq -- ) hexdump write ; diff --git a/extra/html/elements/elements-tests.factor b/extra/html/elements/elements-tests.factor index 786fe0e68c..aab00e0ca3 100644 --- a/extra/html/elements/elements-tests.factor +++ b/extra/html/elements/elements-tests.factor @@ -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 ; [ "" ] [ [ ] make-html-string ] unit-test diff --git a/extra/html/html-tests.factor b/extra/html/html-tests.factor index 5c33df18b3..4e3344855f 100644 --- a/extra/html/html-tests.factor +++ b/extra/html/html-tests.factor @@ -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 drop diff --git a/extra/http/server/templating/templating-tests.factor b/extra/http/server/templating/templating-tests.factor index d979a071f2..d889cd848a 100644 --- a/extra/http/server/templating/templating-tests.factor +++ b/extra/http/server/templating/templating-tests.factor @@ -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 = ; diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index dc83562600..f364b86524 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -93,4 +93,4 @@ DEFER: <% delimiter swap path+ run-template-file ; : template-convert ( infile outfile -- ) - [ run-template-file ] with-stream ; + [ run-template-file ] with-file-writer ; diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 0aca30c4db..4f633f5be1 100755 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -1,6 +1,5 @@ ! Copyright (C) 2007 Adam Wendt. ! See http://factorcode.org/license.txt for BSD license. -! USING: arrays combinators io io.binary io.files io.paths io.encodings.utf16 kernel math math.parser namespaces sequences @@ -121,7 +120,7 @@ C: extended-header id3v2? [ read-id3v2 ] [ f ] if ; : id3v2 ( filename -- tag/f ) - [ read-tag ] with-stream ; + [ read-tag ] with-file-reader ; : file? ( path -- ? ) stat 3drop not ; @@ -136,7 +135,7 @@ C: extended-header [ mp3? ] subset ; : id3? ( file -- ? ) - [ id3v2? ] with-stream ; + [ id3v2? ] with-file-reader ; : id3s ( files -- id3s ) [ id3? ] subset ; diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 99dddb25f0..4bb620083f 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -100,7 +100,7 @@ M: math-inverse inverse [ drop swap-inverse ] [ pull-inverse ] if ; M: pop-inverse inverse - [ "pop-length" word-prop cut-slice swap ] keep + [ "pop-length" word-prop cut-slice swap >quotation ] keep "pop-inverse" word-prop compose call ; : (undo) ( revquot -- ) diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index f0547961bc..25caae036d 100644 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -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 [ "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 diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index 5a93257949..e1c3108952 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -131,16 +131,16 @@ client-addr ! Invalid parameter tests [ - image [ stdio get accept ] with-stream + image [ stdio get accept ] with-file-reader ] must-fail [ - image [ stdio get receive ] with-stream + image [ stdio get receive ] with-file-reader ] must-fail [ - image [ + image [ B{ 1 2 } server-addr stdio get send - ] with-stream + ] with-file-reader ] must-fail diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor index 6c7d6cebb2..4f3bd09613 100644 --- a/extra/json/writer/writer.factor +++ b/extra/json/writer/writer.factor @@ -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 ; diff --git a/extra/logging/insomniac/insomniac.factor b/extra/logging/insomniac/insomniac.factor index 09c6763657..bb143879bf 100755 --- a/extra/logging/insomniac/insomniac.factor +++ b/extra/logging/insomniac/insomniac.factor @@ -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 ; diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor index fec0c3660f..1503e00163 100755 --- a/extra/logging/logging.factor +++ b/extra/logging/logging.factor @@ -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 ; diff --git a/extra/msxml-to-csv/msxml-to-csv.factor b/extra/msxml-to-csv/msxml-to-csv.factor index dcd2819a2a..8a9ba9cf98 100644 --- a/extra/msxml-to-csv/msxml-to-csv.factor +++ b/extra/msxml-to-csv/msxml-to-csv.factor @@ -13,6 +13,6 @@ IN: msxml-to-csv ] map ; : msxml>csv ( infile outfile -- ) - [ + [ file>xml (msxml>csv) print-csv - ] with-stream ; + ] with-file-writer ; diff --git a/extra/pack/pack-tests.factor b/extra/pack/pack-tests.factor index 7a88881189..510e44d34e 100755 --- a/extra/pack/pack-tests.factor +++ b/extra/pack/pack-tests.factor @@ -41,7 +41,7 @@ USING: io io.streams.string kernel namespaces pack strings tools.test ; [ "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 diff --git a/extra/peg/search/search.factor b/extra/peg/search/search.factor index 6b34c03857..21a111f6f7 100755 --- a/extra/peg/search/search.factor +++ b/extra/peg/search/search.factor @@ -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 ; diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index 0591c60014..99360e5509 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -55,7 +55,7 @@ C: 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 diff --git a/extra/serialize/serialize-docs.factor b/extra/serialize/serialize-docs.factor index 5f21b02ae7..e12751d6ab 100644 --- a/extra/serialize/serialize-docs.factor +++ b/extra/serialize/serialize-docs.factor @@ -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 } ; diff --git a/extra/serialize/serialize-tests.factor b/extra/serialize/serialize-tests.factor index e0ecb5393a..6c80c8de7d 100755 --- a/extra/serialize/serialize-tests.factor +++ b/extra/serialize/serialize-tests.factor @@ -38,8 +38,8 @@ C: 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 ] [ 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 [ dup (serialize) (serialize) ] with-serialized - ] string-out [ + ] with-string-writer [ deserialize-sequence all-eq? - ] string-in + ] with-string-reader ] unit-test diff --git a/extra/smtp/smtp-tests.factor b/extra/smtp/smtp-tests.factor index 20130bec2e..784f446b7e 100755 --- a/extra/smtp/smtp-tests.factor +++ b/extra/smtp/smtp-tests.factor @@ -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 [ diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index e15d9511a3..d92b4bd48b 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -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 ; diff --git a/extra/tools/annotations/annotations-tests.factor b/extra/tools/annotations/annotations-tests.factor old mode 100644 new mode 100755 index f1ffdd25ae..da0c85196d --- a/extra/tools/annotations/annotations-tests.factor +++ b/extra/tools/annotations/annotations-tests.factor @@ -1,7 +1,26 @@ -USING: tools.test tools.annotations ; +USING: tools.test tools.annotations math parser ; IN: temporary : foo ; \ foo watch [ ] [ foo ] unit-test + +! erg's bug +GENERIC: some-generic + +M: integer some-generic 1+ ; + +[ 4 ] [ 3 some-generic ] unit-test + +[ ] [ \ some-generic watch ] unit-test + +[ 4 ] [ 3 some-generic ] unit-test + +[ ] [ "IN: temporary USE: math M: integer some-generic 1- ;" eval ] unit-test + +[ 2 ] [ 3 some-generic ] unit-test + +[ ] [ \ some-generic reset ] unit-test + +[ 2 ] [ 3 some-generic ] unit-test diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index 75ae377ea7..7c28983519 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -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" diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 147c307a32..745e3b1842 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -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 ) [ diff --git a/extra/tools/interpreter/interpreter-tests.factor b/extra/tools/interpreter/interpreter-tests.factor index 8afd9eaa0f..644f83c2ca 100755 --- a/extra/tools/interpreter/interpreter-tests.factor +++ b/extra/tools/interpreter/interpreter-tests.factor @@ -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 [ { } ] [ diff --git a/extra/tools/profiler/profiler-docs.factor b/extra/tools/profiler/profiler-docs.factor old mode 100644 new mode 100755 index a8c700b490..89e84bbc86 --- a/extra/tools/profiler/profiler-docs.factor +++ b/extra/tools/profiler/profiler-docs.factor @@ -3,10 +3,11 @@ quotations io strings words definitions ; IN: tools.profiler ARTICLE: "profiling" "Profiling code" -"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:" +"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words and methods which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:" { $list "The optimizing compiler open-codes certain primitives with inline machine code, and in some cases optimizes them out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations." { "Calls to " { $link POSTPONE: inline } " words are not counted.." } + { "Calls to methods which were inlined as a result of type inference are not counted." } "Tail-recursive loops will only count the initial invocation of the word, not every tail call." } "Quotations can be passed to a combinator which calls them with the profiler enabled:" @@ -15,7 +16,8 @@ ARTICLE: "profiling" "Profiling code" { $subsection profile. } { $subsection vocab-profile. } { $subsection usage-profile. } -{ $subsection vocabs-profile. } ; +{ $subsection vocabs-profile. } +{ $subsection method-profile. } ; ABOUT: "profiling" @@ -48,6 +50,9 @@ HELP: usage-profile. HELP: vocabs-profile. { $description "Print a table of cumilative call counts for each vocabulary. Vocabularies whose words were not called are supressed from the output." } ; +HELP: method-profile. +{ $description "Print a table of cumilative call counts for each method. Methods which were not called are supressed from the output." } ; + HELP: profiling ( ? -- ) { $values { "?" "a boolean" } } { $description "Internal primitive to switch on call counting. This word should not be used; instead use " { $link profile } "." } ; diff --git a/extra/tools/profiler/profiler.factor b/extra/tools/profiler/profiler.factor index c35d5a72c8..784c9e8da6 100755 --- a/extra/tools/profiler/profiler.factor +++ b/extra/tools/profiler/profiler.factor @@ -3,7 +3,7 @@ USING: words sequences math prettyprint kernel arrays io io.styles namespaces assocs kernel.private strings combinators sorting math.parser vocabs definitions tools.profiler.private -continuations ; +continuations generic ; IN: tools.profiler : profile ( quot -- ) @@ -28,6 +28,11 @@ C: vocab-profile M: string (profile.) dup write-object ; +M: method-body (profile.) + "method" word-prop + dup method-specializer over method-generic 2array synopsis + swap method-generic write-object ; + : counter. ( obj n -- ) [ >r [ (profile.) ] with-cell r> @@ -63,3 +68,7 @@ M: string (profile.) [ "predicating" word-prop not ] subset [ profile-counter ] map sum ] { } map>assoc counters. ; + +: method-profile. ( -- ) + all-words [ subwords ] map concat + counters counters. ; diff --git a/extra/tools/test/ui/ui.factor b/extra/tools/test/ui/ui.factor index 0376e7f4c7..9b32bc9e10 100755 --- a/extra/tools/test/ui/ui.factor +++ b/extra/tools/test/ui/ui.factor @@ -13,4 +13,4 @@ IN: tools.test.ui swap slip ungraft notify-queued ] with-variable - ] string-out print ; + ] with-string-writer print ; diff --git a/extra/ui/commands/commands-tests.factor b/extra/ui/commands/commands-tests.factor index 0e51eaf25a..de9534ab74 100644 --- a/extra/ui/commands/commands-tests.factor +++ b/extra/ui/commands/commands-tests.factor @@ -27,5 +27,5 @@ testing "testing" "hey" { [ "C+x" ] [ [ { $command testing "testing" com-test-1 } print-element - ] string-out + ] with-string-writer ] unit-test diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index 1e27744f33..54bae31f79 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/extra/ui/gadgets/gadgets-tests.factor @@ -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 \ must-infer \ unparent must-infer diff --git a/extra/ui/gadgets/panes/panes-tests.factor b/extra/ui/gadgets/panes/panes-tests.factor index 248de5e889..848f7919d3 100755 --- a/extra/ui/gadgets/panes/panes-tests.factor +++ b/extra/ui/gadgets/panes/panes-tests.factor @@ -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 diff --git a/extra/ui/gadgets/presentations/presentations-tests.factor b/extra/ui/gadgets/presentations/presentations-tests.factor index 930c81dc9b..c4f693c939 100644 --- a/extra/ui/gadgets/presentations/presentations-tests.factor +++ b/extra/ui/gadgets/presentations/presentations-tests.factor @@ -10,5 +10,5 @@ tuples ; [ "+" ] [ [ \ + f \ pprint dup button-quot call - ] string-out + ] with-string-writer ] unit-test diff --git a/extra/ui/operations/operations-tests.factor b/extra/ui/operations/operations-tests.factor index efa1ac3f52..b7b2224cfa 100755 --- a/extra/ui/operations/operations-tests.factor +++ b/extra/ui/operations/operations-tests.factor @@ -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" [ 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 diff --git a/extra/ui/tools/profiler/profiler.factor b/extra/ui/tools/profiler/profiler.factor old mode 100644 new mode 100755 index 2c25474fa0..cceebbec8b --- a/extra/ui/tools/profiler/profiler.factor +++ b/extra/ui/tools/profiler/profiler.factor @@ -24,6 +24,9 @@ TUPLE: profiler-gadget pane ; : com-vocabs-profile ( gadget -- ) [ vocabs-profile. ] with-profiler-pane ; +: com-method-profile ( gadget -- ) + [ method-profile. ] with-profiler-pane ; + : profiler-help "ui-profiler" help-window ; \ profiler-help H{ { +nullary+ t } } define-command @@ -31,6 +34,7 @@ TUPLE: profiler-gadget pane ; profiler-gadget "toolbar" f { { f com-full-profile } { f com-vocabs-profile } + { f com-method-profile } { T{ key-down f f "F1" } profiler-help } } define-command-map diff --git a/extra/xml/generator/generator-tests.factor b/extra/xml/generator/generator-tests.factor index 5a6b146ac2..d44b713e55 100644 --- a/extra/xml/generator/generator-tests.factor +++ b/extra/xml/generator/generator-tests.factor @@ -1,3 +1,3 @@ USING: tools.test io.streams.string xml.generator xml.writer ; [ "" ] -[ "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 diff --git a/extra/xml/tests/soap.factor b/extra/xml/tests/soap.factor index 1cb6d35505..f5934488c6 100644 --- a/extra/xml/tests/soap.factor +++ b/extra/xml/tests/soap.factor @@ -9,6 +9,6 @@ USING: sequences xml kernel arrays xml.utilities io.files tools.test ; [ assemble-data ] map ; [ "http://www.foxnews.com/oreilly/" ] [ - "extra/xml/test/soap.xml" resource-path file>xml + "extra/xml/tests/soap.xml" resource-path file>xml parse-result first first ] unit-test diff --git a/extra/xml/tests/test.factor b/extra/xml/tests/test.factor index 0198ebacb7..871425559b 100644 --- a/extra/xml/tests/test.factor +++ b/extra/xml/tests/test.factor @@ -7,7 +7,7 @@ USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities ! This is insufficient SYMBOL: xml-file -[ ] [ "extra/xml/test/test.xml" resource-path +[ ] [ "extra/xml/tests/test.xml" resource-path [ file>xml ] with-html-entities xml-file set ] unit-test [ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test [ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test diff --git a/extra/xml/writer/writer.factor b/extra/xml/writer/writer.factor index 8c7b51d756..28b8f26068 100644 --- a/extra/xml/writer/writer.factor +++ b/extra/xml/writer/writer.factor @@ -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 -- ) [ diff --git a/unmaintained/factorbot.factor b/unmaintained/factorbot.factor index 35280fbee2..43940d2f79 100644 --- a/unmaintained/factorbot.factor +++ b/unmaintained/factorbot.factor @@ -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 ; diff --git a/unmaintained/farkup/farkup.factor b/unmaintained/farkup/farkup.factor index 3f8e95c432..894e7ef979 100644 --- a/unmaintained/farkup/farkup.factor +++ b/unmaintained/farkup/farkup.factor @@ -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 ; \ No newline at end of file + [ parse-result-parsed [ tree-write ] with-string-writer ] map ; \ No newline at end of file diff --git a/unmaintained/furnace-onigiri/onigiri.factor b/unmaintained/furnace-onigiri/onigiri.factor index 3c1d43c6f2..a015659c0f 100644 --- a/unmaintained/furnace-onigiri/onigiri.factor +++ b/unmaintained/furnace-onigiri/onigiri.factor @@ -148,13 +148,13 @@ DEFER: name>user [ httpd ] in-thread drop ; : onigiri-dump ( path -- ) - [ + [ [ entry get-global serialize meta get-global serialize user get-global serialize ] with-serialized - ] with-stream ; + ] with-file-writer ; : onigiri-boot ( path -- ) [ diff --git a/unmaintained/io/test/mmap.factor b/unmaintained/io/test/mmap.factor index 43ba7b6cec..faeca551c0 100644 --- a/unmaintained/io/test/mmap.factor +++ b/unmaintained/io/test/mmap.factor @@ -4,9 +4,9 @@ IN: temporary SYMBOL: mmap "mmap-test.txt" \ mmap set [ \ mmap get delete-file ] catch drop -\ mmap get [ +\ mmap get [ "Four" write -] with-stream +] with-file-writer \ mmap get [ >r CHAR: R r> mmap-address 3 set-alien-unsigned-1