From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 9 Oct 2010 01:55:13 +0000 (-0700)
Subject: Remove stream-peek and stream-peek1, re-implement dns vocab to not need this abstraction
X-Git-Tag: 0.97~4260^2~27
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=fbbaef70c43670dd749fa3ec80c0ad1efe05c1bc

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

diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
index f971d0ca7d..ab34bf5a4e 100644
--- a/basis/alien/data/data.factor
+++ b/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 ;
 
diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor
index 92f9387130..40054bc4b0 100644
--- a/basis/delegate/protocols/protocols.factor
+++ b/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-read-partial stream-readln
+stream-read1 stream-read stream-read-partial stream-readln
 stream-read-until ;
 
 PROTOCOL: output-stream-protocol
diff --git a/basis/io/buffers/buffers-docs.factor b/basis/io/buffers/buffers-docs.factor
index f7392126e3..8a233337f0 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-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." } ;
 
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index e2073b0a13..562abad082 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-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
diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor
index 7380e195e7..d2fb5764ff 100644
--- a/basis/io/ports/ports-tests.factor
+++ b/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
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 2b6f0918ff..6c2f75ec80 100644
--- a/basis/io/ports/ports.factor
+++ b/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 ;
 
diff --git a/basis/io/streams/null/null.factor b/basis/io/streams/null/null.factor
index 040301013a..2b62ec938a 100644
--- a/basis/io/streams/null/null.factor
+++ b/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 ;
diff --git a/basis/io/streams/string/string.factor b/basis/io/streams/string/string.factor
index ab18682d18..be9016d1f2 100644
--- a/basis/io/streams/string/string.factor
+++ b/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) ;
diff --git a/basis/io/streams/throwing/throwing.factor b/basis/io/streams/throwing/throwing.factor
index d66df6b4ee..0b1f214d07 100644
--- a/basis/io/streams/throwing/throwing.factor
+++ b/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* ;
diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor
index 0ba65a8802..cc32f30060 100644
--- a/core/io/encodings/encodings-tests.factor
+++ b/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
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 8064a8a14b..1880859db1 100644
--- a/core/io/encodings/encodings.factor
+++ b/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-
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index 408346d83c..aca460cc31 100644
--- a/core/io/io-docs.factor
+++ b/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
diff --git a/core/io/io.factor b/core/io/io.factor
index 3eaf7cefbf..ea37c13dd7 100644
--- a/core/io/io.factor
+++ b/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 ;
diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor
index 2a7de28b8b..1c7826719c 100644
--- a/core/io/streams/byte-array/byte-array-tests.factor
+++ b/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
diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor
index c8c8fc5341..6f9b05cf18 100644
--- a/core/io/streams/byte-array/byte-array.factor
+++ b/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 ;
diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor
index 6d5a828680..63a56b4af1 100644
--- a/core/io/streams/c/c-tests.factor
+++ b/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> [
diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor
index 4370827737..9ebf7f7018 100644
--- a/core/io/streams/c/c.factor
+++ b/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
diff --git a/core/io/streams/memory/memory.factor b/core/io/streams/memory/memory.factor
index 43de1f4311..e7b4338388 100644
--- a/core/io/streams/memory/memory.factor
+++ b/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 ;
diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor
index 838ac18079..22882d6a24 100644
--- a/core/io/streams/sequence/sequence.factor
+++ b/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
 
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 6c1628516f..175ab252e1 100644
--- a/core/sequences/sequences-tests.factor
+++ b/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
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 6cc9ceb523..55398ff02b 100644
--- a/core/sequences/sequences.factor
+++ b/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 ;
diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor
index c16949a84d..54bb03b008 100644
--- a/extra/dns/dns.factor
+++ b/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 drop
-    ] [
-        HEX: C0 mask? [
-            2 read be> HEX: 3fff bitand
-            seek-absolute [ parse-length-bytes , (parse-name) ] with-input-seek
+    read1 [
+        dup HEX: C0 mask? [
+            8 shift read1 bitor HEX: 3fff bitand
+            seek-absolute [
+                read1 parse-length-bytes , (parse-name)
+            ] with-temporary-input-seek
         ] [
             parse-length-bytes , (parse-name)
         ] if
-    ] if-zero ;
+    ] unless-zero ;
 
 : parse-name ( -- sequence )
     [ (parse-name) ] { } make "." join ;
diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor
index 55111113e5..b06210fc00 100644
--- a/extra/images/gif/gif.factor
+++ b/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