From 2ca509a8fe681d58f80d402ea9da2be20b9ab0a0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jul 2010 13:30:57 -0500 Subject: [PATCH] Split off io.streams.throwing from io.streams.limited and update usages of limited streams --- basis/http/server/server.factor | 28 ++-- basis/images/bitmap/bitmap.factor | 10 +- basis/images/bitmap/loading/authors.txt | 1 - basis/images/bitmap/loading/loading.factor | 7 - basis/images/jpeg/jpeg.factor | 21 ++- basis/images/loader/loader.factor | 16 +- basis/io/streams/limited/limited-docs.factor | 72 ++------- basis/io/streams/limited/limited-tests.factor | 149 +++--------------- basis/io/streams/limited/limited.factor | 80 ++++------ basis/io/streams/throwing/authors.txt | 1 + .../io/streams/throwing/throwing-tests.factor | 36 +++++ basis/io/streams/throwing/throwing.factor | 37 +++++ extra/images/gif/gif.factor | 8 +- 13 files changed, 181 insertions(+), 285 deletions(-) delete mode 100644 basis/images/bitmap/loading/authors.txt delete mode 100644 basis/images/bitmap/loading/loading.factor create mode 100644 basis/io/streams/throwing/authors.txt create mode 100644 basis/io/streams/throwing/throwing-tests.factor create mode 100644 basis/io/streams/throwing/throwing.factor diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 95662523d8..9a323bd38d 100644 --- a/basis/http/server/server.factor +++ b/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 - stream-eofs limit-input - binary decode-input - parse-multipart-form-data parse-multipart ; + upload-limit get limited-input + [ "content-type" header ] + [ "content-length" header string>number limited-input ] bi + [ + 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 - ?refresh-all - [ read-request ] ?benchmark - [ do-request ] ?benchmark - [ do-response ] ?benchmark + request-limit get limited-input + [ + ?refresh-all + [ read-request ] ?benchmark + [ do-request ] ?benchmark + [ do-response ] ?benchmark + ] input-throws-on-eof ] with-destructors ; : ( -- server ) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 424efb993a..6c14490778 100644 --- a/basis/images/bitmap/bitmap.factor +++ b/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 -combinators compression.run-length endian fry grouping images -images.loader images.normalization io io.binary -io.encodings.8-bit.latin1 io.encodings.binary -io.encodings.string io.files io.streams.limited kernel locals -macros math math.bitwise math.functions namespaces sequences +USING: accessors alien.c-types arrays byte-arrays combinators +compression.run-length fry grouping images images.loader +images.normalization io io.binary io.encodings.8-bit.latin1 +io.encodings.string kernel math math.bitwise sequences specialized-arrays summary ; QUALIFIED-WITH: bitstreams b SPECIALIZED-ARRAYS: uint ushort ; diff --git a/basis/images/bitmap/loading/authors.txt b/basis/images/bitmap/loading/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/images/bitmap/loading/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor deleted file mode 100644 index 16e0e459f5..0000000000 --- a/basis/images/bitmap/loading/loading.factor +++ /dev/null @@ -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 ; diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index 937c73ceb0..89e6851793 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/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 -images.processing io io.binary io.encodings.binary io.files -io.streams.byte-array kernel locals math math.bitwise -math.constants math.functions math.matrices math.order -math.ranges math.vectors memoize multiline namespaces -sequences sequences.deep images.loader io.streams.limited ; -IN: images.jpeg - +compression.huffman fry grouping images images.loader +images.processing io io.binary io.encodings.binary +io.streams.byte-array io.streams.limited io.streams.throwing +kernel locals math math.bitwise math.blas.matrices +math.blas.vectors math.constants math.functions math.matrices +math.order math.vectors memoize namespaces sequences +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 ] [ length ] bi - stream-throws limit + limit-stream [ [ 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 ; diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 8617a8d442..7f6a5f1dfd 100644 --- a/basis/images/loader/loader.factor +++ b/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 -io.encodings.binary io.files io.pathnames io.streams.byte-array -io.streams.limited kernel namespaces sequences splitting -strings unicode.case ; +USING: assocs byte-arrays io.encodings.binary io.files +io.pathnames io.streams.byte-array io.streams.limited +io.streams.throwing kernel namespaces sequences strings +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 ; + binary ; PRIVATE> @@ -36,9 +36,9 @@ GENERIC: stream>image ( stream class -- image ) M: byte-array load-image* [ - [ binary ] - [ length stream-throws ] bi - ] dip stream>image ; + [ binary ] [ length ] bi + dup + ] dip '[ _ stream>image ] throws-on-eof ; M: limited-stream load-image* stream>image ; diff --git a/basis/io/streams/limited/limited-docs.factor b/basis/io/streams/limited/limited-docs.factor index 6c1806ff38..37f9c2f27b 100644 --- a/basis/io/streams/limited/limited-docs.factor +++ b/basis/io/streams/limited/limited-docs.factor @@ -5,53 +5,29 @@ IN: io.streams.limited HELP: { $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:" - { $example - "USING: continuations io io.streams.limited io.streams.string" - "kernel prettyprint ;" - "[" - " \"123456\" 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:" +{ $examples + "Limiting a longer stream to length three:" { $example "USING: accessors continuations io io.streams.limited" "io.streams.string kernel prettyprint ;" - "\"123456\" 3 stream-eofs limit" + "\"123456\" 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 -{ $values - { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } } -} +HELP: limited-input +{ $values { "limit" integer } } { $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 } -"Make a limited stream throw an exception on exhaustion:" -{ $subsections stream-throws } -"Make a limited stream return " { $link f } " on exhaustion:" -{ $subsections stream-eofs } ; +{ $subsections unlimited-input } ; ABOUT: "io.streams.limited" diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor index 047cd117a0..12e5a38340 100644 --- a/basis/io/streams/limited/limited-tests.factor +++ b/basis/io/streams/limited/limited-tests.factor @@ -11,7 +11,7 @@ IN: io.streams.limited.tests ascii encode binary "data" set ] unit-test -[ ] [ "data" get 24 stream-throws "limited" set ] unit-test +[ ] [ "data" get 24 "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 "data" set ] unit-test -[ ] [ "data" get 7 stream-throws "limited" set ] unit-test +[ ] [ "data" get 4 "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 [ - 5 stream-throws limit-input - "l" read-until - ] with-input-stream -] unit-test [ CHAR: a ] -[ "a" 1 stream-eofs stream-read1 ] unit-test +[ "a" 1 stream-read1 ] unit-test [ "abc" ] [ - "abc" 3 stream-eofs + "abc" 3 4 swap stream-read ] unit-test [ f ] [ - "abc" 3 stream-eofs + "abc" 3 4 over stream-read drop 10 swap stream-read ] unit-test [ t ] [ - "abc" 3 stream-eofs limit unlimited + "abc" 3 limit-stream unlimit-stream "abc" = ] unit-test [ t ] [ - "abc" 3 stream-eofs limit unlimited + "abc" 3 limit-stream unlimit-stream "abc" = ] unit-test @@ -73,145 +70,41 @@ IN: io.streams.limited.tests [ [ "resource:license.txt" utf8 &dispose - 3 stream-eofs limit unlimited + 3 limit-stream unlimit-stream "resource:license.txt" utf8 &dispose [ decoder? ] both? ] with-destructors ] unit-test -[ "HELL" ] [ - "HELLO" - [ f stream-throws limit-input 4 read ] - with-string-reader -] unit-test - [ "asdf" ] [ - "asdf" 2 stream-eofs [ + "asdf" 2 [ unlimited-input contents ] with-input-stream ] unit-test -[ 4 ] [ - "abcdefgh" 4 stream-throws [ - 4 seek-relative seek-input tell-input - ] with-input-stream -] unit-test - -[ - "abcdefgh" 4 stream-throws [ - 4 seek-relative seek-input - 4 read - ] with-input-stream -] [ - limit-exceeded? -] must-fail-with - -[ - "abcdefgh" 4 stream-throws [ - 4 seek-relative seek-input - -2 seek-relative - 2 read - ] with-input-stream -] [ - limit-exceeded? -] must-fail-with - -[ - "abcdefgh" [ - 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" [ - 4 seek-relative seek-input - 2 stream-throws limit-input - 4 seek-absolute seek-input - 2 read - ] with-input-stream -] unit-test - -[ "ef" ] [ - "abcdefgh" [ - 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 +! pipes are duplex and not seekable [ "as" ] [ - latin1 [ 2 stream-throws ] change-in - "asdf" over stream-write dup stream-flush - 2 swap stream-read -] unit-test - -[ - latin1 [ 2 stream-throws ] 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 [ 2 stream-eofs ] change-in + latin1 [ 2 ] change-in "asdf" over stream-write dup stream-flush 2 swap stream-read ] unit-test [ "as" ] [ - latin1 [ 2 stream-eofs ] change-in + latin1 [ 2 ] change-in "asdf" over stream-write dup stream-flush 3 swap stream-read ] unit-test ! test seeking on limited unseekable streams [ "as" ] [ - latin1 [ 2 stream-eofs ] change-in + latin1 [ 2 ] change-in "asdf" over stream-write dup stream-flush 2 swap stream-read ] unit-test [ "as" ] [ - latin1 [ 2 stream-eofs ] change-in + latin1 [ 2 ] change-in "asdf" over stream-write dup stream-flush 3 swap stream-read ] unit-test - -[ - latin1 [ 2 stream-throws ] change-in - 2 seek-absolute rot in>> stream-seek -] must-fail - -[ - "as" -] [ - latin1 [ 2 stream-throws ] 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 [ - 7 read drop - tell-input - ] with-input-stream -] unit-test - -[ 70000 ] [ - image binary stream-throws [ - 70000 read drop - tell-input - ] with-input-stream -] unit-test diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index 25f1d88363..45494b3c1d 100644 --- a/basis/io/streams/limited/limited.factor +++ b/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 - stream mode - count limit - current start stop ; +TUPLE: limited-stream stream count limit current start stop ; -SINGLETONS: stream-throws stream-eofs ; - -: ( stream limit mode -- stream' ) +: ( stream limit -- stream' ) limited-stream new - swap >>mode swap >>limit swap >>stream 0 >>count ; -: ( path encoding mode -- stream' ) - [ - [ ] - [ drop file-info size>> ] 2bi - ] dip ; +: ( path encoding -- stream' ) + [ ] + [ drop file-info size>> ] 2bi + ; -GENERIC# limit 2 ( stream limit mode -- stream' ) +GENERIC# limit-stream 1 ( stream limit -- stream' ) -M: decoder limit ( stream limit mode -- stream' ) - [ clone ] 2dip '[ _ _ limit ] change-stream ; +M: decoder limit-stream ( stream limit -- stream' ) + [ clone ] dip '[ _ limit-stream ] change-stream ; -M: object limit ( stream limit mode -- stream' ) - over [ ] [ 2drop ] if ; +M: object limit-stream ( stream limit -- 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' ) - stream>> ; +M: limited-stream unlimit-stream ( stream -- stream' ) stream>> ; -: limit-input ( limit mode -- ) - [ input-stream ] 2dip '[ _ _ limit ] change ; +M: object unlimit-stream ( stream -- stream' ) ; + +: 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 -- ) - [ limit ] dip call ; inline +: with-limited-stream ( stream limit quot -- ) + [ limit-stream ] dip call ; inline ERROR: limit-exceeded n stream ; -ERROR: bad-stream-mode mode ; - > ] [ stop>> ] bi > [ - dup mode>> { - { stream-throws [ limit-exceeded ] } - { stream-eofs [ - dup [ current>> ] [ stop>> ] bi - - '[ _ - ] dip - ] } - [ bad-stream-mode ] - } case + dup [ current>> ] [ stop>> ] bi - + '[ _ - ] dip ] when ; inline : adjust-count-limit ( n stream -- n' stream ) 2dup [ + ] change-count [ count>> ] [ limit>> ] bi > [ - dup mode>> { - { stream-throws [ limit-exceeded ] } - { stream-eofs [ - dup [ count>> ] [ limit>> ] bi - - '[ _ - ] dip - dup limit>> >>count - ] } - [ bad-stream-mode ] - } case + dup [ count>> ] [ limit>> ] bi - + '[ _ - ] dip + dup limit>> >>count ] 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 { diff --git a/basis/io/streams/throwing/authors.txt b/basis/io/streams/throwing/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/streams/throwing/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/streams/throwing/throwing-tests.factor b/basis/io/streams/throwing/throwing-tests.factor new file mode 100644 index 0000000000..f7b7dc52b8 --- /dev/null +++ b/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" 2 + [ 6 read-partial ] throws-on-eof +] unit-test + +[ + "asdf" 2 + [ contents ] throws-on-eof +] [ stream-exhausted? ] must-fail-with + +[ + "asdf" 2 + [ 2 read read1 ] throws-on-eof +] [ stream-exhausted? ] must-fail-with + +[ + "asdf" 2 + [ 3 read ] throws-on-eof +] [ stream-exhausted? ] must-fail-with + +[ + "asdf" 2 + [ 2 read 2 read ] throws-on-eof +] [ stream-exhausted? ] must-fail-with + +[ + "asdf" 2 + [ contents contents ] throws-on-eof +] [ stream-exhausted? ] must-fail-with diff --git a/basis/io/streams/throwing/throwing.factor b/basis/io/streams/throwing/throwing.factor new file mode 100644 index 0000000000..3ad4d012f7 --- /dev/null +++ b/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 ; + + 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 -- ) + [ ] dip with-input-stream ; inline + +: input-throws-on-eof ( quot -- ) + [ input-stream get ] dip with-input-stream ; inline diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor index 7301cc984f..c72f06f139 100644 --- a/extra/images/gif/gif.factor +++ b/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.encodings.utf8 io.files io.files.info io.ports -io.streams.limited kernel make math math.bitwise math.functions -multiline namespaces prettyprint sequences ; +io.binary io.buffers io.encodings.string io.encodings.utf8 +io.ports kernel make math math.bitwise namespaces sequences ; IN: images.gif SINGLETON: gif-image