basis/io/streams/throwing/throwing.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors destructors io kernel locals namespaces
   4 sequences fry ;
   5 IN: io.streams.throwing
   6
   7 ERROR: stream-exhausted n stream word ;
   8
   9 TUPLE: throws-on-eof-stream stream ;
  10
  11 C: <throws-on-eof-stream> throws-on-eof-stream
  12
  13 <PRIVATE
  14
  15 M: throws-on-eof-stream stream-element-type stream>> stream-element-type ;
  16
  17 M: throws-on-eof-stream dispose stream>> dispose ;
  18
  19 M:: throws-on-eof-stream stream-read1 ( stream -- obj )
  20     stream stream>> stream-read1
  21     [ 1 stream \ read1 stream-exhausted ] unless* ;
  22
  23 M:: throws-on-eof-stream stream-peek1 ( stream -- obj )
  24     stream stream>> stream-peek1
  25     [ 1 stream \ peek1 stream-exhausted ] unless* ;
  26
  27 M:: throws-on-eof-stream stream-read ( n stream -- seq )
  28     n stream stream>> stream-read
  29     dup length n = [ n stream \ read stream-exhausted ] unless ;
  30
  31 M:: throws-on-eof-stream stream-peek ( n stream -- seq )
  32     n stream stream>> stream-peek
  33     dup length n = [ n stream \ peek stream-exhausted ] unless ;
  34
  35 M:: throws-on-eof-stream stream-read-partial ( n stream -- seq )
  36     n stream stream>> stream-read-partial
  37     [ n stream \ read-partial stream-exhausted ] unless* ;
  38
  39 M: throws-on-eof-stream stream-tell
  40     stream>> stream-tell ;
  41
  42 M: throws-on-eof-stream stream-seek
  43     stream>> stream-seek ;
  44
  45 M: throws-on-eof-stream stream-read-until
  46     [ stream>> stream-read-until ]
  47     [ '[ length _ \ read-until stream-exhausted ] unless* ] bi ;
  48
  49 PRIVATE>
  50
  51 : stream-throw-on-eof ( ..a stream quot: ( ..a stream' -- ..b ) -- ..b )
  52     [ <throws-on-eof-stream> ] dip with-input-stream* ; inline
  53
  54 : throw-on-eof ( ..a quot: ( ..a -- ..b ) -- ..b )
  55     [ input-stream get <throws-on-eof-stream> ] dip with-input-stream* ; inline