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 debugger classes byte-arrays namespaces splitting
6 grouping dlists assocs io.encodings.binary summary accessors
7 destructors combinators ;
10 SYMBOL: default-buffer-size
11 64 1024 * default-buffer-size set-global
13 TUPLE: port handle timeout disposed ;
15 M: port timeout timeout>> ;
17 M: port set-timeout (>>timeout) ;
19 : <port> ( handle class -- port )
20 new swap >>handle ; inline
22 TUPLE: buffered-port < port { buffer buffer } ;
24 : <buffered-port> ( handle class -- port )
26 default-buffer-size get <buffer> >>buffer ; inline
28 TUPLE: input-port < buffered-port ;
30 : <input-port> ( handle -- input-port )
31 input-port <buffered-port> ;
33 HOOK: (wait-to-read) io-backend ( port -- )
35 : wait-to-read ( port -- eof? )
36 dup buffer>> buffer-empty? [
37 dup (wait-to-read) buffer>> buffer-empty?
38 ] [ drop f ] if ; inline
40 M: input-port stream-read1
42 dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ;
44 : read-step ( count port -- byte-array/f )
45 dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
47 M: input-port stream-read-partial ( max stream -- byte-array/f )
49 >r 0 max >integer r> read-step ;
51 : read-loop ( count port accum -- )
52 pick over length - dup 0 > [
54 over push-all read-loop
62 M: input-port stream-read
74 : read-until-step ( separators port -- string/f separator/f )
75 dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
77 : read-until-loop ( seps port buf -- separator/f )
78 2over read-until-step over [
79 >r over push-all r> dup [
88 M: input-port stream-read-until ( seps port -- str/f sep/f )
89 2dup read-until-step dup [ >r 2nip r> ] [
92 BV{ } like [ read-until-loop ] keep B{ } like swap
96 TUPLE: output-port < buffered-port ;
98 : <output-port> ( handle -- output-port )
99 output-port <buffered-port> ;
101 : wait-to-write ( len port -- )
102 tuck buffer>> buffer-capacity <=
103 [ drop ] [ stream-flush ] if ;
105 M: output-port stream-write1
108 buffer>> byte>buffer ;
110 M: output-port stream-write
112 over length over buffer>> size>> > [
113 [ buffer>> size>> <groups> ]
114 [ [ stream-write ] curry ] bi
117 [ >r length r> wait-to-write ]
118 [ buffer>> >buffer ] 2bi
121 HOOK: (wait-to-write) io-backend ( port -- )
123 GENERIC: shutdown ( handle -- )
125 M: object shutdown drop ;
127 : port-flush ( port -- )
128 dup buffer>> buffer-empty?
129 [ drop ] [ dup (wait-to-write) port-flush ] if ;
131 M: output-port stream-flush ( port -- )
132 [ check-disposed ] [ port-flush ] bi ;
134 M: output-port dispose*
137 [ handle>> &dispose drop ]
138 [ buffer>> &dispose drop ]
140 [ handle>> shutdown ]
144 M: buffered-port dispose*
145 [ call-next-method ] [ buffer>> dispose ] bi ;
147 M: port cancel-operation handle>> cancel-operation ;
151 [ handle>> &dispose drop ]
152 [ handle>> shutdown ]
156 ! Fast-path optimization
157 USING: hints strings io.encodings.utf8 io.encodings.ascii
158 io.encodings.private ;
160 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
162 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;
164 HINTS: decoder-write { string output-port utf8 } { string output-port ascii } ;