clean up contents and lines words; contents never outputs f now

db4
Slava Pestov 2009-05-10 16:39:51 -05:00
parent f6ff74596e
commit 9488e78532
7 changed files with 54 additions and 30 deletions

View File

@ -48,7 +48,7 @@ concurrency.promises threads unix.process ;
try-process
] unit-test
[ f ] [
[ "" ] [
"cat"
"launcher-test-1" temp-file
2array

View File

@ -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" <string-reader>

View File

@ -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"

View File

@ -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 ;
<PRIVATE
: each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
[ dup ] compose swap while drop ; inline
: stream-element-exemplar ( type -- exemplar )
{
{ +byte+ [ B{ } ] }
{ +character+ [ "" ] }
} case ;
: element-exemplar ( -- exemplar )
input-stream get
stream-element-type
stream-element-exemplar ;
PRIVATE>
: 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

View File

@ -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

View File

@ -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 } }

View File

@ -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
@ -720,12 +721,14 @@ PRIVATE>
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 )
[