Do you like this one ? I feel it is a bit of ugly but I don't know any
better now. 8(
(define (run/io+proc* thunk)
(receive (r1 w1 r2 w2) (lambda ()
(receive (r1 w1) (pipe)
(receive (r2 w2) (pipe)
(values r1 w1 r2 w2))))
(let ((proc (fork (lambda ()
(close r1)
(close w2)
(move->fdes w1 1)
(move->fdes r2 0)
(with-current-input-port*
r2
(lambda ()
(with-current-output-port* w1
thunk)))))))
(close w1)
(close r2)
(values r1 w2 proc))))
(define (run/io* thunk)
(receive (i o proc) (run/io+proc* thunk)
(values i o)))
(define-syntax run/io
(syntax-rules ()
((_ . epf)
(run/io* (lambda () (exec-epf . epf))))
--
zhaoway@public1.ptt.js.cn ><##;> ><#;> iloveqhq at http://bbs.nju.edu.cn
http://c2.com/cgi/wiki?ZhaoWay ><#;> http://advogato.org/person/zhaoway/
keywords nanjing.china.linux.filesystem.iptables.garnome.debian.dpkg.rpm
bash.lex.yacc.gcc.lisp.scheme.o'caml.prolog.latex.php.apache.mysql.emacs
|