1 ! Copyright (C) 2003, 2007 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: hashtables generic kernel math namespaces sequences
4 continuations destructors assocs ;
7 GENERIC: stream-readln ( stream -- str/f )
8 GENERIC: stream-read1 ( stream -- ch/f )
9 GENERIC: stream-read ( n stream -- str/f )
10 GENERIC: stream-read-until ( seps stream -- str/f sep/f )
11 GENERIC: stream-read-partial ( max stream -- str/f )
12 GENERIC: stream-write1 ( ch stream -- )
13 GENERIC: stream-write ( str stream -- )
14 GENERIC: stream-flush ( stream -- )
15 GENERIC: stream-nl ( stream -- )
16 GENERIC: stream-format ( str style stream -- )
17 GENERIC: make-span-stream ( style stream -- stream' )
18 GENERIC: make-block-stream ( style stream -- stream' )
19 GENERIC: make-cell-stream ( style stream -- stream' )
20 GENERIC: stream-write-table ( table-cells style stream -- )
22 : stream-print ( str stream -- )
23 [ stream-write ] keep stream-nl ;
25 : (stream-copy) ( in out -- )
26 64 1024 * pick stream-read-partial
27 [ over stream-write (stream-copy) ] [ 2drop ] if* ;
29 : stream-copy ( in out -- )
30 [ 2dup (stream-copy) ] [ dispose dispose ] [ ]
38 : readln ( -- str/f ) input-stream get stream-readln ;
39 : read1 ( -- ch/f ) input-stream get stream-read1 ;
40 : read ( n -- str/f ) input-stream get stream-read ;
41 : read-until ( seps -- str/f sep/f ) input-stream get stream-read-until ;
42 : read-partial ( n -- str/f ) input-stream get stream-read-partial ;
44 : write1 ( ch -- ) output-stream get stream-write1 ;
45 : write ( str -- ) output-stream get stream-write ;
46 : flush ( -- ) output-stream get stream-flush ;
48 : nl ( -- ) output-stream get stream-nl ;
49 : format ( str style -- ) output-stream get stream-format ;
51 : with-input-stream* ( stream quot -- )
52 input-stream swap with-variable ; inline
54 : with-input-stream ( stream quot -- )
55 [ with-input-stream* ] curry with-disposal ; inline
57 : with-output-stream* ( stream quot -- )
58 output-stream swap with-variable ; inline
60 : with-output-stream ( stream quot -- )
61 [ with-output-stream* ] curry with-disposal ; inline
63 : with-streams* ( input output quot -- )
64 [ output-stream set input-stream set ] prepose with-scope ; inline
66 : with-streams ( input output quot -- )
67 [ [ with-streams* ] 3curry ]
68 [ [ drop dispose dispose ] 3curry ] 3bi
71 : tabular-output ( style quot -- )
72 swap >r { } make r> output-stream get stream-write-table ; inline
74 : with-row ( quot -- )
77 : with-cell ( quot -- )
78 H{ } output-stream get make-cell-stream
79 [ swap with-output-stream ] keep , ; inline
81 : write-cell ( str -- )
82 [ write ] with-cell ; inline
84 : with-style ( style quot -- )
85 swap dup assoc-empty? [
88 output-stream get make-span-stream swap with-output-stream
91 : with-nesting ( style quot -- )
92 >r output-stream get make-block-stream
93 r> with-output-stream ; inline
95 : print ( string -- ) output-stream get stream-print ;
97 : bl ( -- ) " " write ;
99 : lines ( stream -- seq )
100 [ [ readln dup ] [ ] [ drop ] produce ] with-input-stream ;
102 : contents ( stream -- str )
104 [ 65536 read dup ] [ ] [ drop ] produce concat f like
105 ] with-input-stream ;