core/io/io.factor

   1 ! Copyright (C) 2003, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators continuations destructors kernel
   4 math namespaces sequences ;
   5 IN: io
   6
   7 SYMBOLS: +byte+ +character+ ;
   8
   9 GENERIC: stream-element-type ( stream -- type )
  10
  11 GENERIC: stream-peek1 ( stream -- elt/f )
  12 GENERIC: stream-peek ( n stream -- seq/f )
  13 GENERIC: stream-read1 ( stream -- elt )
  14 GENERIC: stream-read ( n stream -- seq )
  15 GENERIC: stream-read-until ( seps stream -- seq sep/f )
  16 GENERIC: stream-read-partial ( n stream -- seq )
  17 GENERIC: stream-readln ( stream -- str/f )
  18
  19 GENERIC: stream-write1 ( elt stream -- )
  20 GENERIC: stream-write ( data stream -- )
  21 GENERIC: stream-flush ( stream -- )
  22 GENERIC: stream-nl ( stream -- )
  23
  24 ERROR: bad-seek-type type ;
  25
  26 SINGLETONS: seek-absolute seek-relative seek-end ;
  27
  28 GENERIC: stream-tell ( stream -- n )
  29 GENERIC: stream-seek ( n seek-type stream -- )
  30
  31 : stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
  32
  33 ! Default streams
  34 SYMBOL: input-stream
  35 SYMBOL: output-stream
  36 SYMBOL: error-stream
  37
  38 : peek1 ( -- elt ) input-stream get stream-peek1 ;
  39 : peek ( n -- seq/f ) input-stream get stream-peek ;
  40 : readln ( -- str/f ) input-stream get stream-readln ;
  41 : read1 ( -- elt ) input-stream get stream-read1 ;
  42 : read ( n -- seq ) input-stream get stream-read ;
  43 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
  44 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
  45 : tell-input ( -- n ) input-stream get stream-tell ;
  46 : tell-output ( -- n ) output-stream get stream-tell ;
  47 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
  48 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
  49
  50 : write1 ( elt -- ) output-stream get stream-write1 ;
  51 : write ( seq -- ) output-stream get stream-write ;
  52 : flush ( -- ) output-stream get stream-flush ;
  53
  54 : nl ( -- ) output-stream get stream-nl ;
  55
  56 : with-input-stream* ( stream quot -- )
  57     input-stream swap with-variable ; inline
  58
  59 : with-input-stream ( stream quot -- )
  60     [ with-input-stream* ] curry with-disposal ; inline
  61
  62 : with-output-stream* ( stream quot -- )
  63     output-stream swap with-variable ; inline
  64
  65 : with-output-stream ( stream quot -- )
  66     [ with-output-stream* ] curry with-disposal ; inline
  67
  68 : with-streams* ( input output quot -- )
  69     swapd [ with-output-stream* ] curry with-input-stream* ; inline
  70
  71 : with-streams ( input output quot -- )
  72     #! We have to dispose of the output stream first, so that
  73     #! if both streams point to the same FD, we get to flush the
  74     #! buffer before closing the FD.
  75     swapd [ with-output-stream ] curry with-input-stream ; inline
  76
  77 : with-input-seek ( n seek-type quot -- )
  78     tell-input [
  79         [ seek-input ] dip call
  80     ] dip seek-absolute seek-input ; inline
  81
  82 : with-input-rewind ( quot -- )
  83     [ 0 seek-absolute ] dip with-input-seek ; inline
  84
  85 : print ( str -- ) output-stream get stream-print ;
  86
  87 : bl ( -- ) " " write ;
  88
  89 : each-morsel ( ..a handler: ( ..a data -- ..b ) reader: ( ..b -- ..a data ) -- ..a )
  90     [ dup ] compose swap while drop ; inline
  91
  92 <PRIVATE
  93
  94 : (stream-element-exemplar) ( type -- exemplar )
  95     {
  96         { +byte+ [ B{ } ] }
  97         { +character+ [ "" ] }
  98     } case ; inline
  99
 100 : stream-element-exemplar ( stream -- exemplar )
 101     stream-element-type (stream-element-exemplar) ; inline
 102
 103 PRIVATE>
 104
 105 : each-stream-line ( stream quot -- )
 106     swap [ stream-readln ] curry each-morsel ; inline
 107
 108 : each-line ( quot -- )
 109     input-stream get swap each-stream-line ; inline
 110
 111 : stream-lines ( stream -- seq )
 112     [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ;
 113
 114 : lines ( -- seq )
 115     input-stream get stream-lines ; inline
 116
 117 : stream-contents ( stream -- seq )
 118     [
 119         [ [ 65536 swap stream-read-partial dup ] curry [ ] produce nip ]
 120         [ stream-element-exemplar concat-as ] bi
 121     ] with-disposal ;
 122
 123 : contents ( -- seq )
 124     input-stream get stream-contents ; inline
 125
 126 : each-stream-block ( stream quot: ( block -- ) -- )
 127     swap [ 8192 swap stream-read-partial ] curry each-morsel ; inline
 128
 129 : each-block ( quot: ( block -- ) -- )
 130     input-stream get swap each-stream-block ; inline
 131
 132 : stream-copy ( in out -- )
 133     [ [ [ write ] each-block ] with-output-stream ]
 134     curry with-input-stream ;