Add stream-peek1 and remove it from images.gif and dns. Add sequence-peek but not stream-peek (yet?)

basis/io/buffers/buffers-docs.factor

@@ -25,7 +25,7 @@ $nl
 }
 "Reading from the buffer:"
 { $subsections
-    buffer-peek
+    buffer-peek1
     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-peek
+HELP: buffer-peek1
 { $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-peek ( buffer -- byte )
+: buffer-peek1 ( buffer -- byte )
     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
 
 : buffer-pop ( buffer -- byte )
-    [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
+    [ buffer-peek1 ] [ 1 swap buffer-consume ] bi ; inline
 
 : buffer-length ( buffer -- n )
     [ fill>> ] [ pos>> ] bi - ; inline

basis/io/ports/ports.factor

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

core/io/io.factor

@@ -8,6 +8,7 @@ SYMBOLS: +byte+ +character+ ;
 
 GENERIC: stream-element-type ( stream -- type )
 
+GENERIC: stream-peek1 ( stream -- byte/f )
 GENERIC: stream-read1 ( stream -- elt )
 GENERIC: stream-read ( n stream -- seq )
 GENERIC: stream-read-until ( seps stream -- seq sep/f )
@@ -33,6 +34,7 @@ SYMBOL: input-stream
 SYMBOL: output-stream
 SYMBOL: error-stream
 
+: peek1 ( -- byte ) input-stream get stream-peek1 ;
 : readln ( -- str/f ) input-stream get stream-readln ;
 : read1 ( -- elt ) input-stream get stream-read1 ;
 : read ( n -- seq ) input-stream get stream-read ;

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

@@ -18,6 +18,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-read-partial stream-read ;
 M: byte-reader stream-read sequence-read ;
 M: byte-reader stream-read1 sequence-read1 ;

core/io/streams/sequence/sequence.factor

@@ -14,6 +14,12 @@ 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,6 +13,11 @@ 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,6 +293,12 @@ 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

@@ -11,17 +11,6 @@ nested-comments random sequences slots.syntax splitting strings
 system unicode.categories vectors vocabs.loader unicode.case ;
 IN: dns
 
-GENERIC: stream-peek1 ( stream -- byte/f )
-
-M: input-port stream-peek1
-    dup check-disposed dup wait-to-read
-    [ drop f ] [ buffer>> buffer-peek ] if ; inline
-
-M: byte-reader stream-peek1
-    [ i>> ] [ underlying>> ] bi ?nth ;
-
-: peek1 ( -- byte ) input-stream get stream-peek1 ;
-
 : with-temporary-input-seek ( n seek-type quot -- )
     tell-input [
         [ seek-input ] dip call

extra/images/gif/gif.factor

@@ -74,14 +74,6 @@ CONSTANT: block-terminator HEX: 00
         V{ } clone >>comment-extensions
         t >>loading? ;
 
-GENERIC: stream-peek1 ( stream -- byte )
-
-M: input-port stream-peek1
-    dup check-disposed dup wait-to-read
-    [ drop f ] [ buffer>> buffer-peek ] if ; inline
-
-: peek1 ( -- byte ) input-stream get stream-peek1 ;
-
 : (read-sub-blocks) ( -- )
     read1 [ read , (read-sub-blocks) ] unless-zero ;