1 ! Copyright (C) 2003, 2009 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-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 )
17 GENERIC: stream-write1 ( elt stream -- )
18 GENERIC: stream-write ( seq stream -- )
19 GENERIC: stream-flush ( stream -- )
20 GENERIC: stream-nl ( stream -- )
22 ERROR: bad-seek-type type ;
24 SINGLETONS: seek-absolute seek-relative seek-end ;
26 GENERIC: stream-tell ( stream -- n )
27 GENERIC: stream-seek ( n seek-type stream -- )
33 : (stream-seek) ( n seek-type stream -- )
35 { seek-absolute [ (>>i) ] }
36 { seek-relative [ [ + ] change-i drop ] }
37 { seek-end [ [ underlying>> length + ] [ (>>i) ] bi ] }
43 : stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
50 : readln ( -- str/f ) input-stream get stream-readln ;
51 : read1 ( -- elt ) input-stream get stream-read1 ;
52 : read ( n -- seq ) input-stream get stream-read ;
53 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
54 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
55 : tell-input ( -- n ) input-stream get stream-tell ;
56 : tell-output ( -- n ) output-stream get stream-tell ;
57 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
58 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
60 : write1 ( elt -- ) output-stream get stream-write1 ;
61 : write ( seq -- ) output-stream get stream-write ;
62 : flush ( -- ) output-stream get stream-flush ;
64 : nl ( -- ) output-stream get stream-nl ;
66 : with-input-stream* ( stream quot -- )
67 input-stream swap with-variable ; inline
69 : with-input-stream ( stream quot -- )
70 [ with-input-stream* ] curry with-disposal ; inline
72 : with-output-stream* ( stream quot -- )
73 output-stream swap with-variable ; inline
75 : with-output-stream ( stream quot -- )
76 [ with-output-stream* ] curry with-disposal ; inline
78 : with-streams* ( input output quot -- )
79 [ output-stream set input-stream set ] prepose with-scope ; inline
81 : with-streams ( input output quot -- )
82 [ [ with-streams* ] 3curry ]
83 [ [ drop dispose dispose ] 3curry ] 3bi
86 : print ( str -- ) output-stream get stream-print ;
88 : bl ( -- ) " " write ;
90 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
91 [ dup ] compose swap while drop ; inline
95 : (stream-element-exemplar) ( type -- exemplar )
98 { +character+ [ "" ] }
101 : stream-element-exemplar ( stream -- exemplar )
102 stream-element-type (stream-element-exemplar) ; inline
104 : element-exemplar ( -- exemplar )
105 input-stream get stream-element-exemplar ; inline
109 : each-stream-line ( stream quot -- )
110 swap [ stream-readln ] curry each-morsel ; inline
112 : each-line ( quot -- )
113 input-stream get swap each-stream-line ; inline
115 : stream-lines ( stream -- seq )
116 [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ;
119 input-stream get stream-lines ; inline
121 : stream-contents ( stream -- seq )
123 [ [ 65536 swap stream-read-partial dup ] curry [ ] produce nip ]
124 [ stream-element-exemplar concat-as ] bi
127 : contents ( -- seq )
128 input-stream get stream-contents ; inline
130 : each-stream-block ( stream quot: ( block -- ) -- )
131 swap [ 8192 swap stream-read-partial ] curry each-morsel ; inline
133 : each-block ( quot: ( block -- ) -- )
134 input-stream get swap each-stream-block ; inline
136 : stream-copy ( in out -- )
137 [ [ [ write ] each-block ] with-output-stream ]
138 curry with-input-stream ;