core/io/io.factor

   1 ! Copyright (C) 2003, 2009 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 <PRIVATE
  30
  31 SLOT: i
  32
  33 : (stream-seek) ( n seek-type stream -- )
  34     swap {
  35         { seek-absolute [ i<< ] }
  36         { seek-relative [ [ + ] change-i drop ] }
  37         { seek-end [ [ underlying>> length + ] [ i<< ] bi ] }
  38         [ bad-seek-type ]
  39     } case ;
  40
  41 PRIVATE>
  42
  43 : stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
  44
  45 ! Default streams
  46 SYMBOL: input-stream
  47 SYMBOL: output-stream
  48 SYMBOL: error-stream
  49
  50 : readln ( -- str/f ) input-stream get stream-readln ;
  51 : read1 ( -- elt ) input-stream get stream-read1 ;
  52 : read ( n -- seq ) input-stream get stream-read ;
  53 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
  54 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
  55 : tell-input ( -- n ) input-stream get stream-tell ;
  56 : tell-output ( -- n ) output-stream get stream-tell ;
  57 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
  58 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
  59
  60 : write1 ( elt -- ) output-stream get stream-write1 ;
  61 : write ( seq -- ) output-stream get stream-write ;
  62 : flush ( -- ) output-stream get stream-flush ;
  63
  64 : nl ( -- ) output-stream get stream-nl ;
  65
  66 : with-input-stream* ( stream quot -- )
  67     input-stream swap with-variable ; inline
  68
  69 : with-input-stream ( stream quot -- )
  70     [ with-input-stream* ] curry with-disposal ; inline
  71
  72 : with-output-stream* ( stream quot -- )
  73     output-stream swap with-variable ; inline
  74
  75 : with-output-stream ( stream quot -- )
  76     [ with-output-stream* ] curry with-disposal ; inline
  77
  78 : with-streams* ( input output quot -- )
  79     [ output-stream set input-stream set ] prepose with-scope ; inline
  80
  81 : with-streams ( input output quot -- )
  82     [ [ with-streams* ] 3curry ]
  83     [ [ drop dispose dispose ] 3curry ] 3bi
  84     [ ] cleanup ; inline
  85
  86 : print ( str -- ) output-stream get stream-print ;
  87
  88 : bl ( -- ) " " write ;
  89
  90 : each-morsel ( ..a handler: ( ..a data -- ..b ) reader: ( ..b -- ..a data ) -- ..a )
  91     [ dup ] compose swap while drop ; inline
  92
  93 <PRIVATE
  94
  95 : (stream-element-exemplar) ( type -- exemplar )
  96     {
  97         { +byte+ [ B{ } ] }
  98         { +character+ [ "" ] }
  99     } case ; inline
 100
 101 : stream-element-exemplar ( stream -- exemplar )
 102     stream-element-type (stream-element-exemplar) ; inline
 103
 104 : element-exemplar ( -- exemplar )
 105     input-stream get stream-element-exemplar ; inline
 106
 107 PRIVATE>
 108
 109 : each-stream-line ( stream quot -- )
 110     swap [ stream-readln ] curry each-morsel ; inline
 111
 112 : each-line ( quot -- )
 113     input-stream get swap each-stream-line ; inline
 114
 115 : stream-lines ( stream -- seq )
 116     [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ;
 117
 118 : lines ( -- seq )
 119     input-stream get stream-lines ; inline
 120
 121 : stream-contents ( stream -- seq )
 122     [
 123         [ [ 65536 swap stream-read-partial dup ] curry [ ] produce nip ]
 124         [ stream-element-exemplar concat-as ] bi
 125     ] with-disposal ;
 126
 127 : contents ( -- seq )
 128     input-stream get stream-contents ; inline
 129
 130 : each-stream-block ( stream quot: ( block -- ) -- )
 131     swap [ 8192 swap stream-read-partial ] curry each-morsel ; inline
 132
 133 : each-block ( quot: ( block -- ) -- )
 134     input-stream get swap each-stream-block ; inline
 135
 136 : stream-copy ( in out -- )
 137     [ [ [ write ] each-block ] with-output-stream ]
 138     curry with-input-stream ;