1 ! Copyright (C) 2003, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators continuations destructors kernel
4 math namespaces sequences ;
7 SYMBOLS: +byte+ +character+ ;
9 GENERIC: stream-element-type ( stream -- type )
11 GENERIC: stream-peek1 ( stream -- elt/f )
12 GENERIC: stream-peek ( n stream -- seq/f )
13 GENERIC: stream-read1 ( stream -- elt )
14 GENERIC: stream-read ( n stream -- seq )
15 GENERIC: stream-read-until ( seps stream -- seq sep/f )
16 GENERIC: stream-read-partial ( n stream -- seq )
17 GENERIC: stream-readln ( stream -- str/f )
19 GENERIC: stream-write1 ( elt stream -- )
20 GENERIC: stream-write ( data stream -- )
21 GENERIC: stream-flush ( stream -- )
22 GENERIC: stream-nl ( stream -- )
24 ERROR: bad-seek-type type ;
26 SINGLETONS: seek-absolute seek-relative seek-end ;
28 GENERIC: stream-tell ( stream -- n )
29 GENERIC: stream-seek ( n seek-type stream -- )
31 : stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
38 : peek1 ( -- elt ) input-stream get stream-peek1 ;
39 : peek ( n -- seq/f ) input-stream get stream-peek ;
40 : readln ( -- str/f ) input-stream get stream-readln ;
41 : read1 ( -- elt ) input-stream get stream-read1 ;
42 : read ( n -- seq ) input-stream get stream-read ;
43 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
44 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
45 : tell-input ( -- n ) input-stream get stream-tell ;
46 : tell-output ( -- n ) output-stream get stream-tell ;
47 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
48 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
50 : write1 ( elt -- ) output-stream get stream-write1 ;
51 : write ( seq -- ) output-stream get stream-write ;
52 : flush ( -- ) output-stream get stream-flush ;
54 : nl ( -- ) output-stream get stream-nl ;
56 : with-input-stream* ( stream quot -- )
57 input-stream swap with-variable ; inline
59 : with-input-stream ( stream quot -- )
60 [ with-input-stream* ] curry with-disposal ; inline
62 : with-output-stream* ( stream quot -- )
63 output-stream swap with-variable ; inline
65 : with-output-stream ( stream quot -- )
66 [ with-output-stream* ] curry with-disposal ; inline
68 : with-streams* ( input output quot -- )
69 swapd [ with-output-stream* ] curry with-input-stream* ; inline
71 : with-streams ( input output quot -- )
72 #! We have to dispose of the output stream first, so that
73 #! if both streams point to the same FD, we get to flush the
74 #! buffer before closing the FD.
75 swapd [ with-output-stream ] curry with-input-stream ; inline
77 : with-input-seek ( n seek-type quot -- )
79 [ seek-input ] dip call
80 ] dip seek-absolute seek-input ; inline
82 : with-input-rewind ( quot -- )
83 [ 0 seek-absolute ] dip with-input-seek ; inline
85 : print ( str -- ) output-stream get stream-print ;
87 : bl ( -- ) " " write ;
89 : each-morsel ( ..a handler: ( ..a data -- ..b ) reader: ( ..b -- ..a data ) -- ..a )
90 [ dup ] compose swap while drop ; inline
94 : (stream-element-exemplar) ( type -- exemplar )
97 { +character+ [ "" ] }
100 : stream-element-exemplar ( stream -- exemplar )
101 stream-element-type (stream-element-exemplar) ; inline
105 : each-stream-line ( stream quot -- )
106 swap [ stream-readln ] curry each-morsel ; inline
108 : each-line ( quot -- )
109 input-stream get swap each-stream-line ; inline
111 : stream-lines ( stream -- seq )
112 [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ;
115 input-stream get stream-lines ; inline
117 : stream-contents ( stream -- seq )
119 [ [ 65536 swap stream-read-partial dup ] curry [ ] produce nip ]
120 [ stream-element-exemplar concat-as ] bi
123 : contents ( -- seq )
124 input-stream get stream-contents ; inline
126 : each-stream-block ( stream quot: ( block -- ) -- )
127 swap [ 8192 swap stream-read-partial ] curry each-morsel ; inline
129 : each-block ( quot: ( block -- ) -- )
130 input-stream get swap each-stream-block ; inline
132 : stream-copy ( in out -- )
133 [ [ [ write ] each-block ] with-output-stream ]
134 curry with-input-stream ;