Implement and document stream-peek

diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
index ab34bf5a4e7f645775db13874210032b6176e957..f971d0ca7dc68418f65f3601326c22fbfb26ab0a 100644 (file)
--- a/basis/alien/data/data.factor
+++ b/basis/alien/data/data.factor
@@ -62,11 +62,13 @@ M: pointer <c-direct-array>
 : malloc-string ( string encoding -- alien )
     string>alien malloc-byte-array ;
 
+M: memory-stream stream-peek
+    [ index>> ] [ alien>> ] bi <displaced-alien>
+    swap memory>byte-array ;
+
 M: memory-stream stream-read
-    [
-        [ index>> ] [ alien>> ] bi <displaced-alien>
-        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 40054bc4b0f721858c81efe706880855898d83d3..92f9387130a58c4fb0465ef31d3e8017b50e347d 100644 (file)
--- 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 d2fb5764ff6ac67ea42f3fe31fad7cdb504d3818..7380e195e7f9e0d4e6aa94a54216886e2dd6fe8a 100644 (file)
--- 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 fbfbddef3fe20e39a208cd61d43ef789ee7f1e6b..2b6f0918ff88dd9300a539b985190d81171c4515 100644 (file)
--- 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 2b62ec938a4b5598a9e4bf22e5eb2e51c8813544..040301013a5245d7d37ed1aa07672be8be51d31a 100644 (file)
--- 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 be9016d1f27ffb87cb577feaa22366abe44c17fc..ab18682d186993b7d50f73b0fd62098f0b082da5 100644 (file)
--- 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 0b1f214d07de92c0fec8083e676c692e7cd74826..d66df6b4ee7b2c0d206b19cd619caaef67fc089d 100644 (file)
--- 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 cc32f30060ba9396940b08220b8c800ea93123bb..0ba65a88028b0c16e745aec12325b615c580f2a5 100644 (file)
--- 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 1880859db19d484d6eee6c8e4b006a56f0fd554b..8064a8a14be4b2189aa59c726a2b1b408fda324d 100644 (file)
--- 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 11848cfa0369fbd1792dae53b661ee9a70c68701..408346d83c464a0b2372fa2f9f8683eabaa08744 100644 (file)
--- 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 441d8d6e99845a36597d34a96a1844cd6e0daf38..3eaf7cefbf8abd128cec2d1a2ddc343340953350 100644 (file)
--- 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 1c7826719cd9eed9a583b98a9dd1ada4c5d2dd93..2a7de28b8b26780f8843ce0b8df5653ac4a6975d 100644 (file)
--- 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 bce2c9bf03c3e2b18d9f0cbb33894a9e2c2ee774..c8c8fc5341081624982f3b68edebb2f5b0dbee1b 100644 (file)
--- 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 63a56b4af116f880e1caf3dcd3c1fd605754f2cf..6d5a828680cdcc006ec69ae50e81318741600d2a 100644 (file)
--- 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 <c-reader> [
+        3 4 * [ peek ] [ peek ] bi =
+    ] with-input-stream
+] unit-test
+
+[ t ] [
+    "test.txt" temp-file "rb" fopen <c-reader> [
+        peek1 peek1 =
+    ] with-input-stream
+] unit-test
+
 ! Writing strings to binary streams should fail
 [
     "test.txt" temp-file "wb" fopen <c-writer> [

diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor
index 9ebf7f701836ea99c4140f31306ad4db8c4d7ed1..4370827737793b2c65069cccacee54eeeb9f04db 100644 (file)
--- 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 e7b4338388c49a1ab22ed3a634299697aa915080..43de1f4311464a1874c247cbe5bbef993d0a3c0d 100644 (file)
--- 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 ea8b0625cfcd8ce52984f4c67036b4e9a03d2385..8baeed4fb5039e1a82188a39b577bdd1f973abfb 100644 (file)
--- 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