From f7af44562523fc6cb67b565c14d237ca0eb39c01 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 Oct 2010 10:16:01 -0500 Subject: [PATCH] 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 | 4 ++-- basis/io/buffers/buffers.factor | 4 ++-- basis/io/ports/ports.factor | 4 ++++ core/io/io.factor | 2 ++ core/io/streams/byte-array/byte-array.factor | 1 + core/io/streams/sequence/sequence.factor | 6 ++++++ core/sequences/sequences-tests.factor | 5 +++++ core/sequences/sequences.factor | 6 ++++++ extra/dns/dns.factor | 11 ----------- extra/images/gif/gif.factor | 8 -------- 10 files changed, 28 insertions(+), 23 deletions(-) diff --git a/basis/io/buffers/buffers-docs.factor b/basis/io/buffers/buffers-docs.factor index 8a233337f0..f7392126e3 100644 --- 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 562abad082..e2073b0a13 100644 --- 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 6c2f75ec80..fbfbddef3f 100644 --- 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 ea37c13dd7..441d8d6e99 100644 --- 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 6f9b05cf18..bce2c9bf03 100644 --- 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 22882d6a24..838ac18079 100644 --- 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 175ab252e1..6c1628516f 100644 --- 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 subseq >vector ] unit-test [ V{ 3 4 } ] [ 0 2 2 4 1 10 dup iota 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" ] must-fail [ -10 3 "hello" ] must-fail [ 2 1 "hello" ] must-fail diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 55398ff02b..6cc9ceb523 100644 --- 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 0d85021cb4..63c071be80 100644 --- 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 c72f06f139..55111113e5 100644 --- 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 ;