From d462355035eb0039d8130cf6e293c614fc6cafe4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 Oct 2010 12:11:51 -0500 Subject: [PATCH] Implement and document stream-peek --- basis/alien/data/data.factor | 10 +-- basis/delegate/protocols/protocols.factor | 3 +- basis/io/ports/ports-tests.factor | 5 ++ basis/io/ports/ports.factor | 2 + basis/io/streams/null/null.factor | 2 + basis/io/streams/string/string.factor | 2 + basis/io/streams/throwing/throwing.factor | 8 +++ core/io/encodings/encodings-tests.factor | 10 +++ core/io/encodings/encodings.factor | 3 + core/io/io-docs.factor | 66 +++++++++++++++++++ core/io/io.factor | 14 +++- .../byte-array/byte-array-tests.factor | 1 + core/io/streams/byte-array/byte-array.factor | 1 + core/io/streams/c/c-tests.factor | 12 ++++ core/io/streams/c/c.factor | 4 ++ core/io/streams/memory/memory.factor | 5 +- extra/dns/dns.factor | 7 +- 17 files changed, 141 insertions(+), 14 deletions(-) diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index ab34bf5a4e..f971d0ca7d 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -62,11 +62,13 @@ M: pointer : malloc-string ( string encoding -- alien ) string>alien malloc-byte-array ; +M: memory-stream stream-peek + [ index>> ] [ alien>> ] bi + swap memory>byte-array ; + M: memory-stream stream-read - [ - [ index>> ] [ alien>> ] bi - swap memory>byte-array - ] [ [ + ] change-index drop ] 2bi ; + [ stream-peek ] + [ [ + ] change-index drop ] 2bi ; M: value-type c-type-rep drop int-rep ; diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor index 40054bc4b0..92f9387130 100644 --- a/basis/delegate/protocols/protocols.factor +++ b/basis/delegate/protocols/protocols.factor @@ -13,7 +13,8 @@ at* assoc-size >alist set-at assoc-clone-like delete-at clear-assoc new-assoc assoc-like ; PROTOCOL: input-stream-protocol -stream-read1 stream-read stream-read-partial stream-readln +stream-peek1 stream-peek stream-read1 stream-read +stream-read-partial stream-readln stream-read-until ; PROTOCOL: output-stream-protocol diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor index d2fb5764ff..7380e195e7 100644 --- a/basis/io/ports/ports-tests.factor +++ b/basis/io/ports/ports-tests.factor @@ -23,3 +23,8 @@ IN: io.ports.tests ] unit-test [ ] [ "test.txt" temp-file delete-file ] unit-test + +[ t ] +[ + "resource:license.txt" binary [ 10 peek 10 peek ] with-file-reader = +] unit-test diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index fbfbddef3f..2b6f0918ff 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -84,6 +84,8 @@ M: input-port stream-read ] [ 2nip ] if ] [ 2nip ] if ; +M: input-port stream-peek [ stream-read ] with-input-rewind ; + : read-until-step ( separators port -- string/f separator/f ) dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ; diff --git a/basis/io/streams/null/null.factor b/basis/io/streams/null/null.factor index 2b62ec938a..040301013a 100644 --- a/basis/io/streams/null/null.factor +++ b/basis/io/streams/null/null.factor @@ -14,6 +14,8 @@ M: null-reader stream-readln drop f ; M: null-reader stream-read1 drop f ; M: null-reader stream-read-until 2drop f f ; M: null-reader stream-read 2drop f ; +M: null-reader stream-peek1 drop f ; +M: null-reader stream-peek 2drop f ; M: null-writer stream-element-type drop +byte+ ; M: null-writer stream-write1 2drop ; diff --git a/basis/io/streams/string/string.factor b/basis/io/streams/string/string.factor index be9016d1f2..ab18682d18 100644 --- a/basis/io/streams/string/string.factor +++ b/basis/io/streams/string/string.factor @@ -13,6 +13,8 @@ M: string-reader stream-element-type drop +character+ ; M: string-reader stream-read-partial stream-read ; M: string-reader stream-read sequence-read ; M: string-reader stream-read1 sequence-read1 ; +M: string-reader stream-peek sequence-peek ; +M: string-reader stream-peek1 sequence-peek1 ; M: string-reader stream-read-until sequence-read-until ; M: string-reader stream-tell i>> ; M: string-reader stream-seek (stream-seek) ; diff --git a/basis/io/streams/throwing/throwing.factor b/basis/io/streams/throwing/throwing.factor index 0b1f214d07..d66df6b4ee 100644 --- a/basis/io/streams/throwing/throwing.factor +++ b/basis/io/streams/throwing/throwing.factor @@ -20,10 +20,18 @@ M:: throws-on-eof-stream stream-read1 ( stream -- obj ) stream stream>> stream-read1 [ 1 stream \ read1 stream-exhausted ] unless* ; +M:: throws-on-eof-stream stream-peek1 ( stream -- obj ) + stream stream>> stream-peek1 + [ 1 stream \ peek1 stream-exhausted ] unless* ; + M:: throws-on-eof-stream stream-read ( n stream -- seq ) n stream stream>> stream-read dup length n = [ n stream \ read stream-exhausted ] unless ; +M:: throws-on-eof-stream stream-peek ( n stream -- seq ) + n stream stream>> stream-peek + dup length n = [ n stream \ peek stream-exhausted ] unless ; + M:: throws-on-eof-stream stream-read-partial ( n stream -- seq ) n stream stream>> stream-read-partial [ n stream \ read-partial stream-exhausted ] unless* ; diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index cc32f30060..0ba65a8802 100644 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -73,3 +73,13 @@ unit-test output-stream get code>> ] with-byte-writer drop ] unit-test + +[ t ] [ + "vocab:io/test/mac-os-eol.txt" + ascii [ 10 peek 10 peek = ] with-file-reader +] unit-test + +[ t ] [ + "vocab:io/test/mac-os-eol.txt" + ascii [ peek1 peek1 = ] with-file-reader +] unit-test diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 1880859db1..8064a8a14b 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -61,6 +61,9 @@ M: decoder stream-seek stream>> stream-seek ; M: decoder stream-read1 dup >decoder< decode-char fix-read1 ; +M: decoder stream-peek1 [ stream-read1 ] with-input-rewind ; +M: decoder stream-peek [ stream-read ] with-input-rewind ; + : fix-read ( stream string -- string ) over cr>> [ over cr- diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index 11848cfa03..408346d83c 100644 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -262,6 +262,61 @@ HELP: contents { $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 ; +HELP: peek +{ $values + { "n" integer } + { "seq/f" "a sequence or f" } +} +{ $description "Reads the next " { $snippet "n" } " elements from the stream and seeks the stream to before the read." } ; + +HELP: peek1 +{ $values + { "elt" "an element or f" } +} +{ $description "Reads the next object from a stream and seeks the stream to before the read." } ; + +HELP: stream-peek +{ $values + { "n" integer } { "stream" "an input stream" } + { "seq/f" "a sequence or f" } +} +{ $contract "Peeks " { $snippet "n" } " elements from the stream. Outputs " { $link f } " on stream exhaustion." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link peek } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: stream-peek1 +{ $values + { "stream" "an input stream" } + { "elt/f" "an element or f" } +} +{ $contract "Peeks an element from the stream. Outputs " { $link f } " on stream exhaustion." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link peek1 } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: tell-input +{ $values + { "n" integer } +} +{ $description "Returns the index of the stream stored in " { $link input-stream } "." } ; + +HELP: tell-output +{ $values + { "n" integer } +} +{ $description "Returns the index of the stream stored in " { $link output-stream } "." } ; + +HELP: with-input-rewind +{ $values + { "quot" quotation } +} +{ $description "Records the current seek position of the stream and calls the quotation. The position is then reset after the call." } ; + +HELP: with-input-seek +{ $values + { "n" integer } { "seek-type" "a seek singleton" } { "quot" quotation } +} +{ $description "Seeks the stream to a location, calls " { $snippet "quot" } ", and resets the input stream to where it was before the quotation was called." } ; + ARTICLE: "stream-protocol" "Stream protocol" "The stream protocol consists of a large number of generic words, many of which are optional." $nl @@ -271,6 +326,8 @@ $nl { $subsections "stream-types" } "These words are required for binary and string input streams:" { $subsections + stream-peek1 + stream-peek stream-read1 stream-read stream-read-until @@ -290,6 +347,8 @@ $nl { $subsections stream-tell stream-seek + tell-input + tell-output } { $see-also "io.timeouts" } ; @@ -338,6 +397,8 @@ ARTICLE: "stdio" "Default input and output streams" $nl "Words reading from the default input stream:" { $subsections + peek1 + peek read1 read read-until @@ -376,6 +437,11 @@ $nl seek-relative seek-end } +"Seeking combinators:" +{ $subsections + with-input-seek + with-input-rewind +} "A pair of combinators for rebinding the " { $link output-stream } " variable:" { $subsections with-output-stream diff --git a/core/io/io.factor b/core/io/io.factor index 441d8d6e99..3eaf7cefbf 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -8,7 +8,8 @@ SYMBOLS: +byte+ +character+ ; GENERIC: stream-element-type ( stream -- type ) -GENERIC: stream-peek1 ( stream -- byte/f ) +GENERIC: stream-peek1 ( stream -- elt/f ) +GENERIC: stream-peek ( n stream -- seq/f ) GENERIC: stream-read1 ( stream -- elt ) GENERIC: stream-read ( n stream -- seq ) GENERIC: stream-read-until ( seps stream -- seq sep/f ) @@ -34,7 +35,8 @@ SYMBOL: input-stream SYMBOL: output-stream SYMBOL: error-stream -: peek1 ( -- byte ) input-stream get stream-peek1 ; +: peek1 ( -- elt ) input-stream get stream-peek1 ; +: peek ( n -- seq/f ) input-stream get stream-peek ; : readln ( -- str/f ) input-stream get stream-readln ; : read1 ( -- elt ) input-stream get stream-read1 ; : read ( n -- seq ) input-stream get stream-read ; @@ -72,6 +74,14 @@ SYMBOL: error-stream #! buffer before closing the FD. swapd [ with-output-stream ] curry with-input-stream ; inline +: with-input-seek ( n seek-type quot -- ) + tell-input [ + [ seek-input ] dip call + ] dip seek-absolute seek-input ; inline + +: with-input-rewind ( quot -- ) + [ 0 seek-absolute ] dip with-input-seek ; inline + : print ( str -- ) output-stream get stream-print ; : bl ( -- ) " " write ; diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor index 1c7826719c..2a7de28b8b 100644 --- a/core/io/streams/byte-array/byte-array-tests.factor +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -8,6 +8,7 @@ IN: io.streams.byte-array.tests [ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test [ B{ 1 2 3 4 5 6 } ] [ binary [ B{ 1 2 3 } write B{ 4 5 6 } write ] with-byte-writer ] unit-test [ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test +[ B{ 1 2 } ] [ B{ 1 2 3 4 } binary [ 2 peek ] 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 } >string utf8 [ write ] with-byte-writer ] unit-test diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index bce2c9bf03..c8c8fc5341 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -19,6 +19,7 @@ TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ; M: byte-reader stream-element-type drop +byte+ ; M: byte-reader stream-peek1 sequence-peek1 ; +M: byte-reader stream-peek sequence-peek ; M: byte-reader stream-read-partial stream-read ; M: byte-reader stream-read sequence-read ; M: byte-reader stream-read1 sequence-read1 ; diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 63a56b4af1..6d5a828680 100644 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -34,6 +34,18 @@ IN: io.streams.c.tests int-array-cast ] unit-test +[ t ] [ + "test.txt" temp-file "rb" fopen [ + 3 4 * [ peek ] [ peek ] bi = + ] with-input-stream +] unit-test + +[ t ] [ + "test.txt" temp-file "rb" fopen [ + peek1 peek1 = + ] with-input-stream +] unit-test + ! Writing strings to binary streams should fail [ "test.txt" temp-file "wb" fopen [ diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 9ebf7f7018..4370827737 100644 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -47,10 +47,14 @@ M: c-reader stream-element-type drop +byte+ ; M: c-reader stream-read dup check-disposed handle>> fread ; +M: c-reader stream-peek [ stream-read ] with-input-rewind ; + M: c-reader stream-read-partial stream-read ; M: c-reader stream-read1 dup check-disposed handle>> fgetc ; +M: c-reader stream-peek1 [ stream-read1 ] with-input-rewind ; + : read-until-loop ( stream delim -- ch ) over stream-read1 dup [ dup pick member-eq? [ 2nip ] [ , read-until-loop ] if diff --git a/core/io/streams/memory/memory.factor b/core/io/streams/memory/memory.factor index e7b4338388..43de1f4311 100644 --- a/core/io/streams/memory/memory.factor +++ b/core/io/streams/memory/memory.factor @@ -10,6 +10,9 @@ TUPLE: memory-stream alien index ; M: memory-stream stream-element-type drop +byte+ ; +M: memory-stream stream-peek1 + [ alien>> ] [ index>> ] bi alien-unsigned-1 ; + M: memory-stream stream-read1 - [ [ alien>> ] [ index>> ] bi alien-unsigned-1 ] + [ stream-peek1 ] [ [ 1 + ] change-index drop ] bi ; diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index ea8b0625cf..8baeed4fb5 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -11,11 +11,6 @@ nested-comments random sequences slots.syntax splitting strings system unicode.categories vectors vocabs.loader unicode.case ; IN: dns -: with-temporary-input-seek ( n seek-type quot -- ) - tell-input [ - [ seek-input ] dip call - ] dip seek-absolute seek-input ; inline - ENUM: dns-type { A 1 } { NS 2 } { MD 3 } { MF 4 } { CNAME 5 } { SOA 6 } { MB 7 } { MG 8 } @@ -176,7 +171,7 @@ CONSTANT: ipv6-arpa-suffix ".ip6.arpa" ] [ HEX: C0 mask? [ 2 read be> HEX: 3fff bitand - seek-absolute [ parse-length-bytes , (parse-name) ] with-temporary-input-seek + seek-absolute [ parse-length-bytes , (parse-name) ] with-input-seek ] [ parse-length-bytes , (parse-name) ] if -- 2.34.1