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