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

diff --git a/basis/io/buffers/buffers-docs.factor b/basis/io/buffers/buffers-docs.factor
index 8a233337f0a23ff6bf6346eeed8a874b386ac118..f7392126e3ceedfe5660d83318a1b849bda42d64 100644 (file)
--- a/basis/io/buffers/buffers-docs.factor
+++ b/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." } ;
 

diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 562abad082fb24911b73cdeeef7c102405694937..e2073b0a13b15aacfc516069969dc18719bab982 100644 (file)
--- a/basis/io/buffers/buffers.factor
+++ b/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

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 6c2f75ec807811a6f4c6d3836802c34cc098003d..fbfbddef3fe20e39a208cd61d43ef789ee7f1e6b 100644 (file)
--- a/basis/io/ports/ports.factor
+++ b/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

diff --git a/core/io/io.factor b/core/io/io.factor
index ea37c13dd7cb00b9ad7ba4347a67ef0cd981ff00..441d8d6e99845a36597d34a96a1844cd6e0daf38 100644 (file)
--- a/core/io/io.factor
+++ b/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 ;

diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor
index 6f9b05cf182cb2a51f4171ec2ef1a1c71f29f7ff..bce2c9bf03c3e2b18d9f0cbb33894a9e2c2ee774 100644 (file)
--- a/core/io/streams/byte-array/byte-array.factor
+++ b/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 ;

diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor
index 22882d6a24eaca585d5ca2ab0c5e47843a767924..838ac18079531bfc1dec48fb51537cc44477d33c 100644 (file)
--- a/core/io/streams/sequence/sequence.factor
+++ b/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
 

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 175ab252e13af9c1d62658e1b304c0d200d3458b..6c1628516f8f25ce437c0a800e6c87221aedd441 100644 (file)
--- a/core/sequences/sequences-tests.factor
+++ b/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

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 55398ff02bedc45b6a02d5ab0b0d015295a8a954..6cc9ceb52357c6094b23c446a0ab81f0a43c76ee 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/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 ;

diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor
index 0d85021cb4ef2618b5c9fe32e84bc2e6ca02c342..63c071be808fba78ba0ce419e4801fbe6fb33f86 100644 (file)
--- a/extra/dns/dns.factor
+++ b/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

diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor
index c72f06f13931ccb2ef777f992500a1e97c359329..55111113e5723ab3d942cd4258d3581ef8128782 100644 (file)
--- a/extra/images/gif/gif.factor
+++ b/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 ;