Remove stream-peek and stream-peek1, re-implement dns vocab to not need this abstraction

basis/alien/data/data.factor

@@ -62,13 +62,11 @@ 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
-    [ stream-peek ]
+    [
-    [ [ + ] change-index drop ] 2bi ;
+        [ index>> ] [ alien>> ] bi <displaced-alien>
+        swap memory>byte-array
+    ] [ [ + ] change-index drop ] 2bi ;
 
 M: value-type c-type-rep drop int-rep ;
 

basis/delegate/protocols/protocols.factor

@@ -13,8 +13,7 @@ at* assoc-size >alist set-at assoc-clone-like
 delete-at clear-assoc new-assoc assoc-like ;
 
 PROTOCOL: input-stream-protocol
-stream-peek1 stream-peek stream-read1 stream-read
+stream-read1 stream-read stream-read-partial stream-readln
-stream-read-partial stream-readln
 stream-read-until ;
 
 PROTOCOL: output-stream-protocol

basis/io/buffers/buffers-docs.factor

@@ -25,7 +25,7 @@ $nl
 }
 "Reading from the buffer:"
 { $subsections
-    buffer-peek1
+    buffer-peek
     buffer-pop
     buffer-read
 }
@@ -98,7 +98,7 @@ HELP: n>buffer
 { $description "Advances the fill pointer by " { $snippet "n" } " bytes." }
 { $warning "This word will leave the buffer in an invalid state if it does not have " { $snippet "n" } " bytes available." } ;
 
-HELP: buffer-peek1
+HELP: buffer-peek
 { $values { "buffer" buffer } { "byte" "a byte" } }
 { $description "Outputs the byte at the buffer position." } ;
 

basis/io/buffers/buffers.factor

@@ -32,11 +32,11 @@ M: buffer dispose* ptr>> free ;
     dup [ pos>> ] [ fill>> ] bi <
     [ 0 >>pos 0 >>fill ] unless drop ; inline
 
-: buffer-peek1 ( buffer -- byte )
+: buffer-peek ( buffer -- byte )
     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
 
 : buffer-pop ( buffer -- byte )
-    [ buffer-peek1 ] [ 1 swap buffer-consume ] bi ; inline
+    [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
 
 : buffer-length ( buffer -- n )
     [ fill>> ] [ pos>> ] bi - ; inline

basis/io/ports/ports-tests.factor

@@ -23,8 +23,3 @@ 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

basis/io/ports/ports.factor

@@ -41,10 +41,6 @@ HOOK: (wait-to-read) io-backend ( port -- )
         dup (wait-to-read) buffer>> buffer-empty?
     ] [ drop f ] if ; inline
 
-M: input-port stream-peek1
-    dup check-disposed dup wait-to-read
-    [ drop f ] [ buffer>> buffer-peek1 ] if ; inline
-
 M: input-port stream-read1
     dup check-disposed
     dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
@@ -84,8 +80,6 @@ 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 ;
 

basis/io/streams/null/null.factor

@@ -14,8 +14,6 @@ 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 ;

basis/io/streams/string/string.factor

@@ -13,8 +13,6 @@ 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) ;

basis/io/streams/throwing/throwing.factor

@@ -20,18 +20,10 @@ 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* ;

core/io/encodings/encodings-tests.factor

@@ -73,13 +73,3 @@ 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

core/io/encodings/encodings.factor

@@ -61,9 +61,6 @@ 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-

core/io/io-docs.factor

@@ -262,37 +262,6 @@ 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 }
@@ -305,18 +274,6 @@ HELP: tell-output
 }
 { $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
@@ -326,8 +283,6 @@ $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
@@ -397,8 +352,6 @@ ARTICLE: "stdio" "Default input and output streams"
 $nl
 "Words reading from the default input stream:"
 { $subsections
-    peek1
-    peek
     read1
     read
     read-until
@@ -431,17 +384,6 @@ $nl
 }
 "Seeking on the default output stream:"
 { $subsections seek-output }
-"Seeking descriptors:"
-{ $subsections
-    seek-absolute
-    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

core/io/io.factor

@@ -8,8 +8,6 @@ SYMBOLS: +byte+ +character+ ;
 
 GENERIC: stream-element-type ( stream -- type )
 
-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 )
@@ -35,8 +33,6 @@ SYMBOL: input-stream
 SYMBOL: output-stream
 SYMBOL: error-stream
 
-: 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 ;
@@ -74,14 +70,6 @@ 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 ;

core/io/streams/byte-array/byte-array-tests.factor

@@ -8,7 +8,6 @@ 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

core/io/streams/byte-array/byte-array.factor

@@ -18,8 +18,6 @@ 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 ;

core/io/streams/c/c-tests.factor

@@ -34,18 +34,6 @@ 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> [

core/io/streams/c/c.factor

@@ -47,14 +47,10 @@ 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

core/io/streams/memory/memory.factor

@@ -10,9 +10,6 @@ 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
-    [ stream-peek1 ]
+    [ [ alien>> ] [ index>> ] bi alien-unsigned-1 ]
     [ [ 1 + ] change-index drop ] bi ;

core/io/streams/sequence/sequence.factor

@@ -14,12 +14,6 @@ SLOT: i
 : next ( stream -- )
     [ 1 + ] change-i drop ; inline
 
-: sequence-peek1 ( seq -- elt/f )
-    [ i>> ] [ underlying>> ] bi ?nth ;
-
-: sequence-peek ( n seq -- elt/f )
-    [ nip i>> dup ] [ [ + ] [ underlying>> ] bi* ] 2bi ?subseq ;
-
 : sequence-read1 ( stream -- elt/f )
     [ >sequence-stream< ?nth ] [ next ] bi ; inline
 

core/sequences/sequences-tests.factor

@@ -13,11 +13,6 @@ IN: sequences.tests
 [ V{ 4 5 } ] [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
 [ V{ 3 4 } ] [ 2 4 1 10 dup iota <slice> subseq >vector ] unit-test
 [ V{ 3 4 } ] [ 0 2 2 4 1 10 dup iota <slice> <slice> subseq >vector ] unit-test
-
-[ "abc" ] [ 0 3 "abc" ?subseq ] unit-test
-[ "abc" ] [ 0 5 "abc" ?subseq ] unit-test
-[ "bc" ] [ 1 5 "abc" ?subseq ] unit-test
-[ "abc" ] [ -1 3 "abc" ?subseq ] unit-test
 [ 0 10 "hello" <slice> ] must-fail
 [ -10 3 "hello" <slice> ] must-fail
 [ 2 1 "hello" <slice> ] must-fail

core/sequences/sequences.factor

@@ -293,12 +293,6 @@ PRIVATE>
 : subseq ( from to seq -- subseq )
     [ check-slice subseq>copy (copy) ] keep like ;
 
-: ?subseq ( from to seq -- subseq )
-    [
-        [ 0 ] dip length [ clamp ] 2curry bi@
-        2dup > [ nip dup ] when
-    ] keep subseq f like ;
-
 : head ( seq n -- headseq ) (head) subseq ;
 
 : tail ( seq n -- tailseq ) (tail) subseq ;

extra/dns/dns.factor

@@ -9,6 +9,11 @@ math.parser namespaces nested-comments random sequences
 slots.syntax splitting system vectors vocabs.loader ;
 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 }
@@ -143,7 +148,8 @@ CONSTANT: ipv4-arpa-suffix ".in-addr.arpa"
 CONSTANT: ipv6-arpa-suffix ".ip6.arpa"
 
 : ipv6>arpa ( string -- string )
-    ipv6>byte-array [ [ -4 shift 4 bits ] [ 4 bits ] bi 2array ] { } map-as
+    ipv6>byte-array
+    [ [ -4 shift 4 bits ] [ 4 bits ] bi 2array ] { } map-as
     B{ } concat-as reverse
     [ >hex ] { } map-as "." join ipv6-arpa-suffix append ;
 
@@ -161,19 +167,19 @@ CONSTANT: ipv6-arpa-suffix ".ip6.arpa"
         first2 swap [ hex> ] bi@ [ 4 shift ] [ ] bi* bitor
     ] B{ } map-as byte-array>ipv6 ;
 
-: parse-length-bytes ( -- sequence ) read1 read utf8 decode ;
+: parse-length-bytes ( byte -- sequence ) read utf8 decode ;
 
 : (parse-name) ( -- )
-    peek1 [
+    read1 [
-        read1 drop
+        dup HEX: C0 mask? [
-    ] [
+            8 shift read1 bitor HEX: 3fff bitand
-        HEX: C0 mask? [
+            seek-absolute [
-            2 read be> HEX: 3fff bitand
+                read1 parse-length-bytes , (parse-name)
-            seek-absolute [ parse-length-bytes , (parse-name) ] with-input-seek
+            ] with-temporary-input-seek
         ] [
             parse-length-bytes , (parse-name)
         ] if
-    ] if-zero ;
+    ] unless-zero ;
 
 : parse-name ( -- sequence )
     [ (parse-name) ] { } make "." join ;

extra/images/gif/gif.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays combinators compression.lzw
 constructors destructors grouping images images.loader io
 io.binary io.buffers io.encodings.string io.encodings.utf8
-io.ports kernel make math math.bitwise namespaces sequences ;
+kernel make math math.bitwise namespaces sequences ;
 IN: images.gif
 
 SINGLETON: gif-image