basis/io/ports/ports.factor

   1 ! Copyright (C) 2005, 2008 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
   6 grouping dlists assocs io.encodings.binary summary accessors
   7 destructors combinators ;
   8 IN: io.ports
   9
  10 SYMBOL: default-buffer-size
  11 64 1024 * default-buffer-size set-global
  12
  13 TUPLE: port handle timeout disposed ;
  14
  15 M: port timeout timeout>> ;
  16
  17 M: port set-timeout (>>timeout) ;
  18
  19 : <port> ( handle class -- port )
  20     new swap >>handle ; inline
  21
  22 TUPLE: buffered-port < port { buffer buffer } ;
  23
  24 : <buffered-port> ( handle class -- port )
  25     <port>
  26         default-buffer-size get <buffer> >>buffer ; inline
  27
  28 TUPLE: input-port < buffered-port ;
  29
  30 : <input-port> ( handle -- input-port )
  31     input-port <buffered-port> ;
  32
  33 HOOK: (wait-to-read) io-backend ( port -- )
  34
  35 : wait-to-read ( port -- eof? )
  36     dup buffer>> buffer-empty? [
  37         dup (wait-to-read) buffer>> buffer-empty?
  38     ] [ drop f ] if ; inline
  39
  40 M: input-port stream-read1
  41     dup check-disposed
  42     dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
  43
  44 : read-step ( count port -- byte-array/f )
  45     dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
  46
  47 M: input-port stream-read-partial ( max stream -- byte-array/f )
  48     dup check-disposed
  49     [ 0 max >integer ] dip read-step ;
  50
  51 : read-loop ( count port accum -- )
  52     pick over length - dup 0 > [
  53         pick read-step dup [
  54             over push-all read-loop
  55         ] [
  56             2drop 2drop
  57         ] if
  58     ] [
  59         2drop 2drop
  60     ] if ;
  61
  62 M: input-port stream-read
  63     dup check-disposed
  64     [ 0 max >fixnum ] dip
  65     2dup read-step dup [
  66         pick over length > [
  67             pick <byte-vector>
  68             [ push-all ] keep
  69             [ read-loop ] keep
  70             B{ } like
  71         ] [ 2nip ] if
  72     ] [ 2nip ] if ;
  73
  74 : read-until-step ( separators port -- string/f separator/f )
  75     dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
  76
  77 : read-until-loop ( seps port buf -- separator/f )
  78     2over read-until-step over [
  79         [ over push-all ] dip dup [
  80             [ 3drop ] dip
  81         ] [
  82             drop read-until-loop
  83         ] if
  84     ] [
  85         [ 2drop 2drop ] dip
  86     ] if ;
  87
  88 M: input-port stream-read-until ( seps port -- str/f sep/f )
  89     2dup read-until-step dup [ [ 2drop ] 2dip ] [
  90         over [
  91             drop
  92             BV{ } like [ read-until-loop ] keep B{ } like swap
  93         ] [ [ 2drop ] 2dip ] if
  94     ] if ;
  95
  96 TUPLE: output-port < buffered-port ;
  97
  98 : <output-port> ( handle -- output-port )
  99     output-port <buffered-port> ;
 100
 101 : wait-to-write ( len port -- )
 102     [ nip ] [ buffer>> buffer-capacity <= ] 2bi
 103     [ drop ] [ stream-flush ] if ; inline
 104
 105 M: output-port stream-write1
 106     dup check-disposed
 107     1 over wait-to-write
 108     buffer>> byte>buffer ; inline
 109
 110 M: output-port stream-write
 111     dup check-disposed
 112     over length over buffer>> size>> > [
 113         [ buffer>> size>> <groups> ]
 114         [ [ stream-write ] curry ] bi
 115         each
 116     ] [
 117         [ [ length ] dip wait-to-write ]
 118         [ buffer>> >buffer ] 2bi
 119     ] if ;
 120
 121 HOOK: (wait-to-write) io-backend ( port -- )
 122
 123 GENERIC: shutdown ( handle -- )
 124
 125 M: object shutdown drop ;
 126
 127 : port-flush ( port -- )
 128     dup buffer>> buffer-empty?
 129     [ drop ] [ dup (wait-to-write) port-flush ] if ;
 130
 131 M: output-port stream-flush ( port -- )
 132     [ check-disposed ] [ port-flush ] bi ;
 133
 134 M: output-port dispose*
 135     [
 136         {
 137             [ handle>> &dispose drop ]
 138             [ buffer>> &dispose drop ]
 139             [ port-flush ]
 140             [ handle>> shutdown ]
 141         } cleave
 142     ] with-destructors ;
 143
 144 M: buffered-port dispose*
 145     [ call-next-method ] [ buffer>> dispose ] bi ;
 146
 147 M: port cancel-operation handle>> cancel-operation ;
 148
 149 M: port dispose*
 150     [
 151         [ handle>> &dispose drop ]
 152         [ handle>> shutdown ]
 153         bi
 154     ] with-destructors ;
 155
 156 GENERIC: underlying-port ( stream -- port )
 157
 158 M: port underlying-port ;
 159
 160 M: encoder underlying-port stream>> underlying-port ;
 161
 162 M: decoder underlying-port stream>> underlying-port ;
 163
 164 GENERIC: underlying-handle ( stream -- handle )
 165
 166 M: object underlying-handle underlying-port handle>> ;
 167
 168 ! Fast-path optimization
 169 USING: hints strings io.encodings.utf8 io.encodings.ascii
 170 io.encodings.private ;
 171
 172 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
 173
 174 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;
 175
 176 HINTS: encoder-write { string output-port utf8 } { string output-port ascii } ;