basis/io/ports/ports.factor

   1 ! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math kernel io sequences io.buffers io.timeouts generic
   4 byte-vectors system io.encodings math.order io.backend
   5 continuations classes byte-arrays namespaces splitting grouping
   6 dlists alien alien.c-types assocs io.encodings.binary summary
   7 accessors destructors combinators fry specialized-arrays ;
   8 SPECIALIZED-ARRAY: uchar
   9 IN: io.ports
  10
  11 SYMBOL: default-buffer-size
  12 64 1024 * default-buffer-size set-global
  13
  14 TUPLE: port < disposable handle timeout ;
  15
  16 M: port timeout timeout>> ;
  17
  18 M: port set-timeout timeout<< ;
  19
  20 : <port> ( handle class -- port )
  21     new-disposable swap >>handle ; inline
  22
  23 TUPLE: buffered-port < port { buffer buffer } ;
  24
  25 : <buffered-port> ( handle class -- port )
  26     <port>
  27         default-buffer-size get <buffer> >>buffer ; inline
  28
  29 TUPLE: input-port < buffered-port ;
  30
  31 M: input-port stream-element-type drop +byte+ ; inline
  32
  33 : <input-port> ( handle -- input-port )
  34     input-port <buffered-port> ;
  35
  36 HOOK: (wait-to-read) io-backend ( port -- )
  37
  38 : wait-to-read ( port -- eof? )
  39     dup buffer>> buffer-empty? [
  40         dup (wait-to-read) buffer>> buffer-empty?
  41     ] [ drop f ] if ; inline
  42
  43 M: input-port stream-read1
  44     dup check-disposed
  45     dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
  46
  47 : read-step ( count port -- byte-array/f )
  48     dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
  49
  50 M: input-port stream-read-partial ( max stream -- byte-array/f )
  51     dup check-disposed
  52     [ 0 max >integer ] dip read-step ;
  53
  54 : read-loop ( count port accum -- )
  55     pick over length - dup 0 > [
  56         pick read-step dup [
  57             append! read-loop
  58         ] [
  59             2drop 2drop
  60         ] if
  61     ] [
  62         2drop 2drop
  63     ] if ;
  64
  65 M: input-port stream-read
  66     dup check-disposed
  67     [ 0 max >fixnum ] dip
  68     2dup read-step dup [
  69         pick over length > [
  70             pick <byte-vector>
  71             [ push-all ] keep
  72             [ read-loop ] keep
  73             B{ } like
  74         ] [ 2nip ] if
  75     ] [ 2nip ] if ;
  76
  77 : read-until-step ( separators port -- string/f separator/f )
  78     dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
  79
  80 : read-until-loop ( seps port buf -- separator/f )
  81     2over read-until-step over [
  82         [ append! ] dip dup [
  83             [ 3drop ] dip
  84         ] [
  85             drop read-until-loop
  86         ] if
  87     ] [
  88         [ 2drop 2drop ] dip
  89     ] if ;
  90
  91 M: input-port stream-read-until ( seps port -- str/f sep/f )
  92     2dup read-until-step dup [ [ 2drop ] 2dip ] [
  93         over [
  94             drop
  95             BV{ } like [ read-until-loop ] keep B{ } like swap
  96         ] [ [ 2drop ] 2dip ] if
  97     ] if ;
  98
  99 TUPLE: output-port < buffered-port ;
 100
 101 : <output-port> ( handle -- output-port )
 102     output-port <buffered-port> ;
 103
 104 : wait-to-write ( len port -- )
 105     [ nip ] [ buffer>> buffer-capacity <= ] 2bi
 106     [ drop ] [ stream-flush ] if ; inline
 107
 108 M: output-port stream-element-type stream>> stream-element-type ; inline
 109
 110 M: output-port stream-write1
 111     dup check-disposed
 112     1 over wait-to-write
 113     buffer>> byte>buffer ; inline
 114
 115 : write-in-groups ( byte-array port -- )
 116     [ binary-object <direct-uchar-array> ] dip
 117     [ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
 118     each ;
 119
 120 M: output-port stream-write
 121     dup check-disposed
 122     2dup [ byte-length ] [ buffer>> size>> ] bi* > [
 123         write-in-groups
 124     ] [
 125         [ [ byte-length ] dip wait-to-write ]
 126         [ buffer>> >buffer ] 2bi
 127     ] if ;
 128
 129 HOOK: (wait-to-write) io-backend ( port -- )
 130
 131 HOOK: tell-handle os ( handle -- n )
 132 HOOK: seek-handle os ( n seek-type handle -- )
 133
 134 M: buffered-port stream-tell ( stream -- n )
 135     [ check-disposed ]
 136     [ handle>> tell-handle ]
 137     [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
 138
 139 M: input-port stream-seek ( n seek-type stream -- )
 140     [ check-disposed ]
 141     [ buffer>> 0 swap buffer-reset ]
 142     [ handle>> seek-handle ] tri ;
 143
 144 M: output-port stream-seek ( n seek-type stream -- )
 145     [ check-disposed ]
 146     [ stream-flush ]
 147     [ handle>> seek-handle ] tri ;
 148
 149 GENERIC: shutdown ( handle -- )
 150
 151 M: object shutdown drop ;
 152
 153 : port-flush ( port -- )
 154     dup buffer>> buffer-empty?
 155     [ drop ] [ dup (wait-to-write) port-flush ] if ;
 156
 157 M: output-port stream-flush ( port -- )
 158     [ check-disposed ] [ port-flush ] bi ;
 159
 160 M: output-port dispose*
 161     [
 162         {
 163             [ handle>> &dispose drop ]
 164             [ buffer>> &dispose drop ]
 165             [ port-flush ]
 166             [ handle>> shutdown ]
 167         } cleave
 168     ] with-destructors ;
 169
 170 M: buffered-port dispose*
 171     [ call-next-method ] [ buffer>> dispose ] bi ;
 172
 173 M: port cancel-operation handle>> cancel-operation ;
 174
 175 M: port dispose*
 176     [
 177         [ handle>> &dispose drop ]
 178         [ handle>> shutdown ]
 179         bi
 180     ] with-destructors ;
 181
 182 GENERIC: underlying-port ( stream -- port )
 183
 184 M: port underlying-port ;
 185
 186 M: encoder underlying-port stream>> underlying-port ;
 187
 188 M: decoder underlying-port stream>> underlying-port ;
 189
 190 GENERIC: underlying-handle ( stream -- handle )
 191
 192 M: object underlying-handle underlying-port handle>> ;
 193
 194 ! Fast-path optimization
 195 USING: hints strings io.encodings.utf8 io.encodings.ascii
 196 io.encodings.private ;
 197
 198 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
 199
 200 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;