From 9488e7853294d005742dc56952495dbb0056d1cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 10 May 2009 16:39:51 -0500 Subject: [PATCH] clean up contents and lines words; contents never outputs f now --- basis/io/launcher/unix/unix-tests.factor | 2 +- basis/io/streams/string/string-tests.factor | 2 ++ core/io/io-docs.factor | 8 ++--- core/io/io.factor | 36 ++++++++++++------- .../byte-array/byte-array-tests.factor | 1 + core/sequences/sequences-docs.factor | 8 ++++- core/sequences/sequences.factor | 27 +++++++------- 7 files changed, 54 insertions(+), 30 deletions(-) diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor index 99d45e4fd7..852d8171e4 100644 --- a/basis/io/launcher/unix/unix-tests.factor +++ b/basis/io/launcher/unix/unix-tests.factor @@ -48,7 +48,7 @@ concurrency.promises threads unix.process ; try-process ] unit-test -[ f ] [ +[ "" ] [ "cat" "launcher-test-1" temp-file 2array diff --git a/basis/io/streams/string/string-tests.factor b/basis/io/streams/string/string-tests.factor index 967c0d4613..27971f1431 100644 --- a/basis/io/streams/string/string-tests.factor +++ b/basis/io/streams/string/string-tests.factor @@ -2,6 +2,8 @@ USING: io.streams.string io kernel arrays namespaces make tools.test ; IN: io.streams.string.tests +[ "" ] [ "" [ contents ] with-string-reader ] unit-test + [ "line 1" CHAR: l ] [ "line 1\nline 2\nline 3" diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index 97b143e989..ac74e6b11e 100644 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -239,13 +239,13 @@ HELP: each-block { $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ; HELP: stream-contents -{ $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } } -{ $description "Reads the entire contents of a stream. If the stream is empty, outputs " { $link f } "." } +{ $values { "stream" "an input stream" } { "seq" { $or string byte-array } } } +{ $description "Reads all elements in the given stream until the stream is exhausted. The type of the sequence depends on the stream's element type." } $io-error ; HELP: contents -{ $values { "seq" "a string, byte array or " { $link f } } } -{ $description "Reads the entire contents of a the stream stored in " { $link input-stream } ". If the stream is empty, outputs " { $link f } "." } +{ $values { "seq" { $or string byte-array } } } +{ $description "Reads all elements in the " { $link input-stream } " until the stream is exhausted. The type of the sequence depends on the stream's element type." } $io-error ; ARTICLE: "stream-protocol" "Stream protocol" diff --git a/core/io/io.factor b/core/io/io.factor index b43098bcd4..669f104a5f 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: hashtables generic kernel math namespaces make sequences -continuations destructors assocs ; +continuations destructors assocs combinators ; IN: io SYMBOLS: +byte+ +character+ ; @@ -20,7 +20,9 @@ GENERIC: stream-flush ( stream -- ) GENERIC: stream-nl ( stream -- ) ERROR: bad-seek-type type ; + SINGLETONS: seek-absolute seek-relative seek-end ; + GENERIC: stream-seek ( n seek-type stream -- ) : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ; @@ -68,29 +70,39 @@ SYMBOL: error-stream : bl ( -- ) " " write ; -: stream-lines ( stream -- seq ) - [ [ readln dup ] [ ] produce nip ] with-input-stream ; - -: lines ( -- seq ) - input-stream get stream-lines ; - : each-line ( quot -- ) [ readln ] each-morsel ; inline -: stream-contents ( stream -- seq ) - [ - [ 65536 read-partial dup ] [ ] produce nip concat f like - ] with-input-stream ; +: lines ( -- seq ) + [ ] accumulator [ each-line ] dip { } like ; + +: stream-lines ( stream -- seq ) + [ lines ] with-input-stream ; : contents ( -- seq ) - input-stream get stream-contents ; + [ 65536 read-partial dup ] [ ] produce nip + element-exemplar concat-as ; + +: stream-contents ( stream -- seq ) + [ contents ] with-input-stream ; : each-block ( quot: ( block -- ) -- ) [ 8192 read-partial ] each-morsel ; inline diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor index 0cd35dfa21..43a8373232 100644 --- a/core/io/streams/byte-array/byte-array-tests.factor +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -1,6 +1,7 @@ USING: tools.test io.streams.byte-array io.encodings.binary io.encodings.utf8 io kernel arrays strings namespaces ; +[ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test [ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test [ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index cfd96789b4..b6cfface12 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -533,12 +533,18 @@ HELP: concat { $description "Concatenates a sequence of sequences together into one sequence. If " { $snippet "seq" } " is empty, outputs " { $snippet "{ }" } ", otherwise the resulting sequence is of the same class as the first element of " { $snippet "seq" } "." } { $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as the first element of " { $snippet "seq" } "." } ; +HELP: concat-as +{ $values { "seq" sequence } { "exemplar" sequence } { "newseq" sequence } } +{ $description "Concatenates a sequence of sequences together into one sequence with the same type as " { $snippet "exemplar" } "." } +{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." } ; + HELP: join { $values { "seq" sequence } { "glue" sequence } { "newseq" sequence } } { $description "Concatenates a sequence of sequences together into one sequence, placing a copy of " { $snippet "glue" } " between each pair of sequences. The resulting sequence is of the same class as " { $snippet "glue" } "." } +{ $notes "If the " { $snippet "glue" } " sequence is empty, this word calls " { $link concat-as } "." } { $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "glue" } "." } ; -{ join concat } related-words +{ join concat concat-as } related-words HELP: peek { $values { "seq" sequence } { "elt" object } } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d60602fc71..dd48501fa0 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -704,13 +704,14 @@ PRIVATE> : sum-lengths ( seq -- n ) 0 [ length + ] reduce ; +: concat-as ( seq exemplar -- newseq ) + swap [ { } ] [ + [ sum-lengths over new-resizable ] keep + [ over push-all ] each + ] if-empty swap like ; + : concat ( seq -- newseq ) - [ { } ] [ - [ sum-lengths ] keep - [ first new-resizable ] keep - [ [ over push-all ] each ] keep - first like - ] if-empty ; + [ { } ] [ dup first concat-as ] if-empty ; PRIVATE> : join ( seq glue -- newseq ) - [ - 2dup joined-length over new-resizable [ - [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi - interleave - ] keep - ] keep like ; + dup empty? [ concat-as ] [ + [ + 2dup joined-length over new-resizable [ + [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi + interleave + ] keep + ] keep like + ] if ; : padding ( seq n elt quot -- newseq ) [