core/io/io.factor

   1 ! Copyright (C) 2003, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: hashtables generic kernel math namespaces make sequences
   4 continuations destructors assocs combinators ;
   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 ( seq 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-seek ( n seek-type stream -- )
  27
  28 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
  29
  30 ! Default streams
  31 SYMBOL: input-stream
  32 SYMBOL: output-stream
  33 SYMBOL: error-stream
  34
  35 : readln ( -- str/f ) input-stream get stream-readln ;
  36 : read1 ( -- elt ) input-stream get stream-read1 ;
  37 : read ( n -- seq ) input-stream get stream-read ;
  38 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
  39 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
  40 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
  41 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
  42
  43 : write1 ( elt -- ) output-stream get stream-write1 ;
  44 : write ( seq -- ) output-stream get stream-write ;
  45 : flush ( -- ) output-stream get stream-flush ;
  46
  47 : nl ( -- ) output-stream get stream-nl ;
  48
  49 : with-input-stream* ( stream quot -- )
  50     input-stream swap with-variable ; inline
  51
  52 : with-input-stream ( stream quot -- )
  53     [ with-input-stream* ] curry with-disposal ; inline
  54
  55 : with-output-stream* ( stream quot -- )
  56     output-stream swap with-variable ; inline
  57
  58 : with-output-stream ( stream quot -- )
  59     [ with-output-stream* ] curry with-disposal ; inline
  60
  61 : with-streams* ( input output quot -- )
  62     [ output-stream set input-stream set ] prepose with-scope ; inline
  63
  64 : with-streams ( input output quot -- )
  65     [ [ with-streams* ] 3curry ]
  66     [ [ drop dispose dispose ] 3curry ] 3bi
  67     [ ] cleanup ; inline
  68
  69 : print ( str -- ) output-stream get stream-print ;
  70
  71 : bl ( -- ) " " write ;
  72
  73 <PRIVATE
  74
  75 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
  76     [ dup ] compose swap while drop ; inline
  77
  78 : stream-element-exemplar ( type -- exemplar )
  79     {
  80         { +byte+ [ B{ } ] }
  81         { +character+ [ "" ] }
  82     } case ;
  83
  84 : element-exemplar ( -- exemplar )
  85     input-stream get
  86     stream-element-type
  87     stream-element-exemplar ;
  88
  89 PRIVATE>
  90
  91 : each-line ( quot -- )
  92     [ readln ] each-morsel ; inline
  93
  94 : lines ( -- seq )
  95     [ ] accumulator [ each-line ] dip { } like ;
  96
  97 : stream-lines ( stream -- seq )
  98     [ lines ] with-input-stream ;
  99
 100 : contents ( -- seq )
 101     [ 65536 read-partial dup ] [ ] produce nip
 102     element-exemplar concat-as ;
 103
 104 : stream-contents ( stream -- seq )
 105     [ contents ] with-input-stream ;
 106
 107 : each-block ( quot: ( block -- ) -- )
 108     [ 8192 read-partial ] each-morsel ; inline
 109
 110 : stream-copy ( in out -- )
 111     [ [ [ write ] each-block ] with-output-stream ]
 112     curry with-input-stream ;