2005-01-30 15:57:25 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-06-19 17:50:35 -04:00
|
|
|
IN: io
|
|
|
|
USING: errors generic kernel lists math namespaces sequences
|
|
|
|
strings ;
|
2005-04-22 20:09:46 -04:00
|
|
|
|
2005-06-19 18:31:02 -04:00
|
|
|
SYMBOL: stdio
|
2005-04-22 20:09:46 -04:00
|
|
|
|
2005-04-15 22:28:37 -04:00
|
|
|
! Stream protocol.
|
2005-07-21 21:43:37 -04:00
|
|
|
GENERIC: stream-flush ( stream -- )
|
|
|
|
GENERIC: stream-finish ( stream -- )
|
|
|
|
GENERIC: stream-readln ( stream -- string )
|
|
|
|
GENERIC: stream-read1 ( stream -- char/f )
|
|
|
|
GENERIC: stream-read ( count stream -- string )
|
|
|
|
GENERIC: stream-write1 ( char stream -- )
|
|
|
|
GENERIC: stream-format ( string style stream -- )
|
|
|
|
GENERIC: stream-close ( stream -- )
|
|
|
|
GENERIC: set-timeout ( timeout stream -- )
|
|
|
|
|
|
|
|
: stream-write ( string stream -- )
|
|
|
|
f swap stream-format ;
|
2005-02-14 22:15:02 -05:00
|
|
|
|
2005-07-21 21:05:17 -04:00
|
|
|
: stream-terpri ( stream -- )
|
2005-07-21 23:36:40 -04:00
|
|
|
"\n" over stream-write stream-finish ;
|
2005-07-21 21:05:17 -04:00
|
|
|
|
2005-02-14 22:15:02 -05:00
|
|
|
: stream-print ( string stream -- )
|
2005-07-21 23:36:40 -04:00
|
|
|
[ stream-write ] keep stream-terpri ;
|
2004-12-15 16:57:29 -05:00
|
|
|
|
2005-06-19 18:31:02 -04:00
|
|
|
: (stream-copy) ( in out -- )
|
2005-07-21 21:43:37 -04:00
|
|
|
4096 pick stream-read
|
2005-09-24 15:21:17 -04:00
|
|
|
[ over stream-write (stream-copy) ] [ 2drop ] if* ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
|
|
|
: stream-copy ( in out -- )
|
2005-09-20 20:18:01 -04:00
|
|
|
[ 2dup (stream-copy) ] [ stream-close stream-close ] cleanup ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
2005-04-15 22:28:37 -04:00
|
|
|
! Think '/dev/null'.
|
|
|
|
TUPLE: null-stream ;
|
|
|
|
M: null-stream stream-flush drop ;
|
2005-07-21 21:05:17 -04:00
|
|
|
M: null-stream stream-finish drop ;
|
2005-04-15 22:28:37 -04:00
|
|
|
M: null-stream stream-readln drop f ;
|
|
|
|
M: null-stream stream-read 2drop f ;
|
2005-06-19 00:23:01 -04:00
|
|
|
M: null-stream stream-read1 drop f ;
|
2005-07-17 14:48:55 -04:00
|
|
|
M: null-stream stream-write1 2drop ;
|
2005-07-21 21:43:37 -04:00
|
|
|
M: null-stream stream-format 3drop ;
|
2005-04-15 22:28:37 -04:00
|
|
|
M: null-stream stream-close drop ;
|
|
|
|
|
2005-01-30 15:57:25 -05:00
|
|
|
! Sometimes, we want to have a delegating stream that uses stdio
|
|
|
|
! words.
|
2005-03-08 22:54:59 -05:00
|
|
|
TUPLE: wrapper-stream scope ;
|
2004-12-25 21:28:47 -05:00
|
|
|
|
2005-01-30 15:57:25 -05:00
|
|
|
C: wrapper-stream ( stream -- stream )
|
2005-05-03 04:40:13 -04:00
|
|
|
2dup set-delegate [
|
2005-08-22 02:06:32 -04:00
|
|
|
>r [ stdio set ] make-hash r> set-wrapper-stream-scope
|
2005-01-30 15:57:25 -05:00
|
|
|
] keep ;
|
2005-02-24 20:52:17 -05:00
|
|
|
|
2005-05-03 04:40:13 -04:00
|
|
|
: with-wrapper ( stream quot -- )
|
2005-07-28 23:33:18 -04:00
|
|
|
>r wrapper-stream-scope r> bind ; inline
|