Split off io.streams.throwing from io.streams.limited and update usages of limited streams

basis/http/server/server.factor

@@ -14,6 +14,7 @@ io.encodings.ascii
 io.encodings.binary
 io.streams.limited
 io.streams.string
+io.streams.throwing
 io.servers.connection
 io.timeouts
 io.crlf
@@ -50,13 +51,14 @@ ERROR: no-boundary ;
 SYMBOL: upload-limit
 
 : read-multipart-data ( request -- mime-parts )
-    [ "content-type" header ]
-    [ "content-length" header string>number ] bi
     unlimited-input
-    upload-limit get stream-throws limit-input
+    upload-limit get limited-input 
-    stream-eofs limit-input
+    [ "content-type" header ]
-    binary decode-input
+    [ "content-length" header string>number limited-input ] bi
-    parse-multipart-form-data parse-multipart ;
+    [
+        binary decode-input
+        parse-multipart-form-data parse-multipart
+    ] input-throws-on-eof ;
 
 : read-content ( request -- bytes )
     "content-length" header string>number read ;
@@ -277,15 +279,17 @@ TUPLE: http-server < threaded-server ;
 
 SYMBOL: request-limit
 
-64 1024 * request-limit set-global
+request-limit [ 64 1024 * ] initialize
 
 M: http-server handle-client*
     drop [
-        request-limit get stream-throws limit-input
+        request-limit get limited-input
-        ?refresh-all
+        [
-        [ read-request ] ?benchmark
+            ?refresh-all
-        [ do-request ] ?benchmark
+            [ read-request ] ?benchmark
-        [ do-response ] ?benchmark
+            [ do-request ] ?benchmark
+            [ do-response ] ?benchmark
+        ] input-throws-on-eof
     ] with-destructors ;
 
 : <http-server> ( -- server )

basis/images/bitmap/bitmap.factor

@@ -1,11 +1,9 @@
 ! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types arrays byte-arrays columns
+USING: accessors alien.c-types arrays byte-arrays combinators
-combinators compression.run-length endian fry grouping images
+compression.run-length fry grouping images images.loader
-images.loader images.normalization io io.binary
+images.normalization io io.binary io.encodings.8-bit.latin1
-io.encodings.8-bit.latin1 io.encodings.binary
+io.encodings.string kernel math math.bitwise sequences
-io.encodings.string io.files io.streams.limited kernel locals
-macros math math.bitwise math.functions namespaces sequences
 specialized-arrays summary ;
 QUALIFIED-WITH: bitstreams b
 SPECIALIZED-ARRAYS: uint ushort ;

basis/images/bitmap/loading/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/images/bitmap/loading/loading.factor

@@ -1,7 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays byte-arrays combinators
-compression.run-length fry grouping images images.loader io
-io.binary io.encodings.binary
-io.encodings.string io.streams.limited kernel math math.bitwise
-io.encodings.8-bit.latin1 sequences specialized-arrays summary images.bitmap ;

basis/images/jpeg/jpeg.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2009 Marc Fauconneau.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays byte-arrays combinators
-grouping compression.huffman images fry
+compression.huffman fry grouping images images.loader
-images.processing io io.binary io.encodings.binary io.files
+images.processing io io.binary io.encodings.binary
-io.streams.byte-array kernel locals math math.bitwise
+io.streams.byte-array io.streams.limited io.streams.throwing
-math.constants math.functions math.matrices math.order
+kernel locals math math.bitwise math.blas.matrices
-math.ranges math.vectors memoize multiline namespaces
+math.blas.vectors math.constants math.functions math.matrices
-sequences sequences.deep images.loader io.streams.limited ;
+math.order math.vectors memoize namespaces sequences
-IN: images.jpeg
+sequences.deep ;
-
 QUALIFIED-WITH: bitstreams bs
+IN: images.jpeg
 
 SINGLETON: jpeg-image
 
@@ -121,7 +121,7 @@ TUPLE: jpeg-color-info
 
 : decode-huff-table ( chunk -- )
     data>> [ binary <byte-reader> ] [ length ] bi
-    stream-throws limit
+    limit-stream <throws-on-eof>
     [   
         [ input-stream get [ count>> ] [ limit>> ] bi < ]
         [
@@ -219,9 +219,6 @@ MEMO: dct-matrix ( -- m ) 64 iota [ 8 /mod dct-vect flatten ] map ;
 
 : idct-factor ( b -- b' ) dct-matrix v.m ;
 
-USE: math.blas.vectors
-USE: math.blas.matrices
-
 MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
 : V.M ( x A -- x.A ) Mtranspose swap M.V ;
 : idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ;

basis/images/loader/loader.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs byte-arrays combinators images
+USING: assocs byte-arrays io.encodings.binary io.files
-io.encodings.binary io.files io.pathnames io.streams.byte-array
+io.pathnames io.streams.byte-array io.streams.limited
-io.streams.limited kernel namespaces sequences splitting
+io.streams.throwing kernel namespaces sequences strings
-strings unicode.case ;
+unicode.case fry ;
 IN: images.loader
 
 ERROR: unknown-image-extension extension ;
@@ -18,7 +18,7 @@ types [ H{ } clone ] initialize
     [ unknown-image-extension ] unless ;
 
 : open-image-file ( path -- stream )
-    binary stream-throws <limited-file-reader> ;
+    binary <limited-file-reader> ;
 
 PRIVATE>
 
@@ -36,9 +36,9 @@ GENERIC: stream>image ( stream class -- image )
 
 M: byte-array load-image*
     [
-        [ binary <byte-reader> ]
+        [ binary <byte-reader> ] [ length ] bi
-        [ length stream-throws <limited-stream> ] bi
+        <limited-stream> dup
-    ] dip stream>image ;
+    ] dip '[ _ stream>image ] throws-on-eof ;
 
 M: limited-stream load-image* stream>image ;
 

basis/io/streams/limited/limited-docs.factor

@@ -5,53 +5,29 @@ IN: io.streams.limited
 
 HELP: <limited-stream>
 { $values
-     { "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
+     { "stream" "an input stream" } { "limit" integer }
      { "stream'" "an input stream" }
 }
-{ $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit } " or " { $link limit-input } "." } ;
+{ $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit-stream } " or " { $link limited-input } "." } ;
 
-HELP: limit
+HELP: limit-stream
 { $values
-     { "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
+     { "stream" "an input stream" } { "limit" integer }
      { "stream'" "a stream" }
 }
 { $description "Changes a decoder's stream to be a limited stream, or wraps " { $snippet "stream" } " in a " { $link limited-stream } "." }
-{ $examples "Throwing an exception:"
+{ $examples
-    { $example
+    "Limiting a longer stream to length three:"
-        "USING: continuations io io.streams.limited io.streams.string"
-        "kernel prettyprint ;"
-        "["
-        "    \"123456\" <string-reader> 3 stream-throws limit"
-        "    100 swap stream-read ."
-        "] [ ] recover ."
-"""T{ limit-exceeded
-    { n 1 }
-    { stream
-        T{ limited-stream
-            { stream
-                T{ string-reader
-                    { underlying "123456" }
-                    { i 3 }
-                }
-            }
-            { mode stream-throws }
-            { count 4 }
-            { limit 3 }
-        }
-    }
-}"""
-    }
-    "Returning " { $link f } " on exhaustion:"
     { $example
         "USING: accessors continuations io io.streams.limited"
         "io.streams.string kernel prettyprint ;"
-        "\"123456\" <string-reader> 3 stream-eofs limit"
+        "\"123456\" <string-reader> 3 limit-stream"
         "100 swap stream-read ."
         "\"123\""
     }
 } ;
 
-HELP: unlimited
+HELP: unlimit-stream
 { $values
      { "stream" "an input stream" }
      { "stream'" "a stream" }
@@ -64,42 +40,22 @@ HELP: limited-stream
 }
 { $description "Limited streams wrap other streams, changing their behavior to throw an exception or return " { $link f } " upon exhaustion." } ;
 
-HELP: limit-input
+HELP: limited-input
-{ $values
+{ $values { "limit" integer } }
-     { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
-}
 { $description "Wraps the current " { $link input-stream } " in a " { $link limited-stream } "." } ;
 
 HELP: unlimited-input
 { $description "Returns the underlying stream of the limited-stream stored in " { $link input-stream } "." } ;
 
-HELP: stream-eofs
-{ $values
-    { "value" { $link stream-throws } " or " { $link stream-eofs } }
-}
-{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will return " { $link f } " upon exhaustion." } ;
-
-HELP: stream-throws
-{ $values
-    { "value" { $link stream-throws } " or " { $link stream-eofs } }
-}
-{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will throw " { $link limit-exceeded } " upon exhaustion." } ;
-
-{ stream-eofs stream-throws } related-words
-
 ARTICLE: "io.streams.limited" "Limited input streams"
 "The " { $vocab-link "io.streams.limited" } " vocabulary wraps a stream to behave as if it had only a limited number of bytes, either throwing an error or returning " { $link f } " upon reaching the end. Limiting a non-seekable stream keeps a byte count and triggers the end-of-stream behavior when this byte count has been reached. However, limiting a seekable stream creates a window of bytes that supports seeking and re-reading of bytes in that window." $nl
 "Wrap a stream in a limited stream:"
-{ $subsections limit }
+{ $subsections limited-stream }
 "Wrap the current " { $link input-stream } " in a limited stream:"
-{ $subsections limit-input }
+{ $subsections limited-input }
 "Unlimits a limited stream:"
-{ $subsections unlimited }
+{ $subsections unlimit-stream }
 "Unlimits the current " { $link input-stream } ":"
-{ $subsections unlimited-input }
+{ $subsections unlimited-input } ;
-"Make a limited stream throw an exception on exhaustion:"
-{ $subsections stream-throws }
-"Make a limited stream return " { $link f } " on exhaustion:"
-{ $subsections stream-eofs } ;
 
 ABOUT: "io.streams.limited"

basis/io/streams/limited/limited-tests.factor

@@ -11,7 +11,7 @@ IN: io.streams.limited.tests
     ascii encode binary <byte-reader> "data" set
 ] unit-test
 
-[ ] [ "data" get 24 stream-throws <limited-stream> "limited" set ] unit-test
+[ ] [ "data" get 24 <limited-stream> "limited" set ] unit-test
 
 [ CHAR: h ] [ "limited" get stream-read1 ] unit-test
 
@@ -21,51 +21,48 @@ IN: io.streams.limited.tests
 
 [ "how " ] [ 4 "decoded" get stream-read ] unit-test
 
-[ "decoded" get stream-readln ] [ limit-exceeded? ] must-fail-with
+[ "are you " ] [ "decoded" get stream-readln ] unit-test
+
+[ f ] [ "decoded" get stream-readln ] unit-test
+
 
 [ ] [
     "abc\ndef\nghi"
     ascii encode binary <byte-reader> "data" set
 ] unit-test
 
-[ ] [ "data" get 7 stream-throws <limited-stream> "limited" set ] unit-test
+[ ] [ "data" get 4 <limited-stream> "limited" set ] unit-test
 
-[ "abc" CHAR: \n ] [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
+[ "abc" CHAR: \n ]
+[ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
 
-[ "\n" "limited" get stream-read-until ] [ limit-exceeded? ] must-fail-with
+[ "" f ] [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
 
-[ "he" CHAR: l ] [
-    B{ CHAR: h CHAR: e CHAR: l CHAR: l CHAR: o }
-    ascii <byte-reader> [
-        5 stream-throws limit-input
-        "l" read-until
-    ] with-input-stream
-] unit-test
 
 [ CHAR: a ]
-[ "a" <string-reader> 1 stream-eofs <limited-stream> stream-read1 ] unit-test
+[ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test
 
 [ "abc" ]
 [
-    "abc" <string-reader> 3 stream-eofs <limited-stream>
+    "abc" <string-reader> 3 <limited-stream>
     4 swap stream-read
 ] unit-test
 
 [ f ]
 [
-    "abc" <string-reader> 3 stream-eofs <limited-stream>
+    "abc" <string-reader> 3 <limited-stream>
     4 over stream-read drop 10 swap stream-read
 ] unit-test
 
 [ t ]
 [
-    "abc" <string-reader> 3 stream-eofs limit unlimited
+    "abc" <string-reader> 3 limit-stream unlimit-stream
     "abc" <string-reader> =
 ] unit-test
 
 [ t ]
 [
-    "abc" <string-reader> 3 stream-eofs limit unlimited
+    "abc" <string-reader> 3 limit-stream unlimit-stream
     "abc" <string-reader> =
 ] unit-test
 
@@ -73,145 +70,41 @@ IN: io.streams.limited.tests
 [
     [
         "resource:license.txt" utf8 <file-reader> &dispose
-        3 stream-eofs limit unlimited
+        3 limit-stream unlimit-stream
         "resource:license.txt" utf8 <file-reader> &dispose
         [ decoder? ] both?
     ] with-destructors
 ] unit-test
 
-[ "HELL" ] [
-    "HELLO"
-    [ f stream-throws limit-input 4 read ]
-    with-string-reader
-] unit-test
-
 
 [ "asdf" ] [
-    "asdf" <string-reader> 2 stream-eofs <limited-stream> [
+    "asdf" <string-reader> 2 <limited-stream> [
         unlimited-input contents
     ] with-input-stream
 ] unit-test
 
-[ 4 ] [
+! pipes are duplex and not seekable
-    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
-        4 seek-relative seek-input tell-input
-    ] with-input-stream
-] unit-test
-
-[
-    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
-        4 seek-relative seek-input
-        4 read
-    ] with-input-stream
-] [
-    limit-exceeded?
-] must-fail-with
-
-[
-    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
-        4 seek-relative seek-input
-        -2 seek-relative
-        2 read
-    ] with-input-stream
-] [
-    limit-exceeded?
-] must-fail-with
-
-[
-    "abcdefgh" <string-reader> [
-        4 seek-relative seek-input
-        2 stream-throws limit-input
-        -2 seek-relative seek-input
-        2 read
-    ] with-input-stream
-] [
-    limit-exceeded?
-] must-fail-with
-
-[ "ef" ] [
-    "abcdefgh" <string-reader> [
-        4 seek-relative seek-input
-        2 stream-throws limit-input
-        4 seek-absolute seek-input
-        2 read
-    ] with-input-stream
-] unit-test
-
-[ "ef" ] [
-    "abcdefgh" <string-reader> [
-        4 seek-absolute seek-input
-        2 stream-throws limit-input
-        2 seek-absolute seek-input
-        4 seek-absolute seek-input
-        2 read
-    ] with-input-stream
-] unit-test
-
-! stream-throws, pipes are duplex and not seekable
 [ "as" ] [
-    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+    latin1 <pipe> [ 2 <limited-stream> ] change-in
-    "asdf" over stream-write dup stream-flush
-    2 swap stream-read
-] unit-test
-
-[
-    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
-    "asdf" over stream-write dup stream-flush
-    3 swap stream-read
-] [
-    limit-exceeded?
-] must-fail-with
-
-! stream-eofs, pipes are duplex and not seekable
-[ "as" ] [
-    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
     "asdf" over stream-write dup stream-flush
     2 swap stream-read
 ] unit-test
 
 [ "as" ] [
-    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    latin1 <pipe> [ 2 <limited-stream> ] change-in
     "asdf" over stream-write dup stream-flush
     3 swap stream-read
 ] unit-test
 
 ! test seeking on limited unseekable streams
 [ "as" ] [
-    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    latin1 <pipe> [ 2 <limited-stream> ] change-in
     "asdf" over stream-write dup stream-flush
     2 swap stream-read
 ] unit-test
 
 [ "as" ] [
-    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    latin1 <pipe> [ 2 <limited-stream> ] change-in
     "asdf" over stream-write dup stream-flush
     3 swap stream-read
 ] unit-test
-
-[
-    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
-    2 seek-absolute rot in>> stream-seek
-] must-fail
-
-[
-    "as"
-] [
-    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
-    "asdf" over stream-write dup stream-flush
-    [ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover
-    2 swap stream-read
-] unit-test
-
-[ 7 ] [
-    image binary stream-throws <limited-file-reader> [
-        7 read drop
-        tell-input
-    ] with-input-stream
-] unit-test
-
-[ 70000 ] [
-    image binary stream-throws <limited-file-reader> [
-        70000 read drop
-        tell-input
-    ] with-input-stream
-] unit-test

basis/io/streams/limited/limited.factor

@@ -6,87 +6,67 @@ io.encodings io.files io.files.info kernel locals math
 namespaces sequences ;
 IN: io.streams.limited
 
-TUPLE: limited-stream
+TUPLE: limited-stream stream count limit current start stop ;
-    stream mode
-    count limit
-    current start stop ;
 
-SINGLETONS: stream-throws stream-eofs ;
+: <limited-stream> ( stream limit -- stream' )
-
-: <limited-stream> ( stream limit mode -- stream' )
     limited-stream new
-        swap >>mode
         swap >>limit
         swap >>stream
         0 >>count ;
 
-: <limited-file-reader> ( path encoding mode -- stream' )
+: <limited-file-reader> ( path encoding -- stream' )
-    [
+    [ <file-reader> ]
-        [ <file-reader> ]
+    [ drop file-info size>> ] 2bi
-        [ drop file-info size>> ] 2bi
+    <limited-stream> ;
-    ] dip <limited-stream> ;
 
-GENERIC# limit 2 ( stream limit mode -- stream' )
+GENERIC# limit-stream 1 ( stream limit -- stream' )
 
-M: decoder limit ( stream limit mode -- stream' )
+M: decoder limit-stream ( stream limit -- stream' )
-    [ clone ] 2dip '[ _ _ limit ] change-stream ;
+    [ clone ] dip '[ _ limit-stream ] change-stream ;
 
-M: object limit ( stream limit mode -- stream' )
+M: object limit-stream ( stream limit -- stream' )
-    over [ <limited-stream> ] [ 2drop ] if ;
+    <limited-stream> ;
 
-GENERIC: unlimited ( stream -- stream' )
+GENERIC: unlimit-stream ( stream -- stream' )
 
-M: decoder unlimited ( stream -- stream' )
+M: decoder unlimit-stream ( stream -- stream' )
     [ stream>> ] change-stream ;
 
-M: object unlimited ( stream -- stream' )
+M: limited-stream unlimit-stream ( stream -- stream' ) stream>> ;
-    stream>> ;
 
-: limit-input ( limit mode -- )
+M: object unlimit-stream ( stream -- stream' ) ;
-    [ input-stream ] 2dip '[ _ _ limit ] change ;
+
+: limited-input ( limit -- )
+    [ input-stream ] dip '[ _ limit-stream ] change ;
 
 : unlimited-input ( -- )
-    input-stream [ unlimited ] change ;
+    input-stream [ unlimit-stream ] change ;
 
 : with-unlimited-stream ( stream quot -- )
-    [ clone unlimited ] dip call ; inline
+    [ clone unlimit-stream ] dip call ; inline
 
-: with-limited-stream ( stream limit mode quot -- )
+: with-limited-stream ( stream limit quot -- )
-    [ limit ] dip call ; inline
+    [ limit-stream ] dip call ; inline
 
 ERROR: limit-exceeded n stream ;
 
-ERROR: bad-stream-mode mode ;
-
 <PRIVATE
 
 : adjust-current-limit ( n stream -- n' stream )
     2dup [ + ] change-current
     [ current>> ] [ stop>> ] bi >
     [
-        dup mode>> {
+        dup [ current>> ] [ stop>> ] bi -
-            { stream-throws [ limit-exceeded ] }
+        '[ _ - ] dip
-            { stream-eofs [ 
-                dup [ current>> ] [ stop>> ] bi -
-                '[ _ - ] dip
-            ] }
-            [ bad-stream-mode ]
-        } case
     ] when ; inline
 
 : adjust-count-limit ( n stream -- n' stream )
     2dup [ + ] change-count
     [ count>> ] [ limit>> ] bi >
     [
-        dup mode>> {
+        dup [ count>> ] [ limit>> ] bi -
-            { stream-throws [ limit-exceeded ] }
+        '[ _ - ] dip
-            { stream-eofs [ 
+        dup limit>> >>count
-                dup [ count>> ] [ limit>> ] bi -
-                '[ _ - ] dip
-                dup limit>> >>count
-            ] }
-            [ bad-stream-mode ]
-        } case
     ] when ; inline
 
 : check-count-bounds ( n stream -- n stream )
@@ -124,7 +104,11 @@ M: limited-stream stream-read-partial
 
 : (read-until) ( stream seps buf -- stream seps buf sep/f )
     3dup [ [ stream-read1 dup ] dip member-eq? ] dip
-    swap [ drop ] [ push (read-until) ] if ;
+    swap [
+        drop
+    ] [
+        over [ push (read-until) ] [ drop ] if
+    ] if ;
 
 :: limited-stream-seek ( n seek-type stream -- )
     seek-type {

basis/io/streams/throwing/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/io/streams/throwing/throwing-tests.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io io.streams.limited io.streams.string
+io.streams.throwing tools.test ;
+IN: io.streams.throwing.tests
+
+[ "as" ]
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ 6 read-partial ] throws-on-eof
+] unit-test
+
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ contents ] throws-on-eof
+] [ stream-exhausted? ] must-fail-with
+
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ 2 read read1 ] throws-on-eof
+] [ stream-exhausted? ] must-fail-with
+
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ 3 read ] throws-on-eof
+] [ stream-exhausted? ] must-fail-with
+
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ 2 read 2 read ] throws-on-eof
+] [ stream-exhausted? ] must-fail-with
+
+[
+    "asdf" <string-reader> 2 <limited-stream>
+    [ contents contents ] throws-on-eof
+] [ stream-exhausted? ] must-fail-with

basis/io/streams/throwing/throwing.factor

@@ -0,0 +1,37 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors destructors io kernel locals namespaces
+sequences ;
+IN: io.streams.throwing
+
+ERROR: stream-exhausted n stream word ;
+
+<PRIVATE
+
+TUPLE: throws-on-eof stream ;
+
+C: <throws-on-eof> throws-on-eof
+
+M: throws-on-eof stream-element-type stream>> stream-element-type ;
+
+M: throws-on-eof dispose stream>> dispose ;
+
+M:: throws-on-eof stream-read1 ( stream -- obj )
+    stream stream>> stream-read1
+    [ 1 stream \ read1 stream-exhausted ] unless* ;
+
+M:: throws-on-eof stream-read ( n stream -- seq )
+    n stream stream>> stream-read
+    dup length n = [ n stream \ read stream-exhausted ] unless ;
+
+M:: throws-on-eof stream-read-partial ( n stream -- seq )
+    n stream stream>> stream-read-partial
+    [ n stream \ read-partial stream-exhausted ] unless* ;
+
+PRIVATE>
+
+: throws-on-eof ( stream quot -- )
+    [ <throws-on-eof> ] dip with-input-stream ; inline
+
+: input-throws-on-eof ( quot -- )
+    [ input-stream get <throws-on-eof> ] dip with-input-stream ; inline

extra/images/gif/gif.factor

@@ -1,11 +1,9 @@
 ! Copyrigt (C) 2009 Doug Coleman, Keith Lazuka
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compression.lzw
+USING: accessors arrays combinators compression.lzw
 constructors destructors grouping images images.loader io
-io.binary io.buffers io.encodings.binary io.encodings.string
+io.binary io.buffers io.encodings.string io.encodings.utf8
-io.encodings.utf8 io.files io.files.info io.ports
+io.ports kernel make math math.bitwise namespaces sequences ;
-io.streams.limited kernel make math math.bitwise math.functions
-multiline namespaces prettyprint sequences ;
 IN: images.gif
 
 SINGLETON: gif-image