clean up contents and lines words; contents never outputs f now
parent
f6ff74596e
commit
9488e78532
|
@ -48,7 +48,7 @@ concurrency.promises threads unix.process ;
|
|||
try-process
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
[ "" ] [
|
||||
"cat"
|
||||
"launcher-test-1" temp-file
|
||||
2array
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 } }
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue