diff options
author | Mark H Weaver <mhw@netris.org> | 2013-11-17 02:46:08 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-11-17 04:54:04 -0500 |
commit | aa2d1143a05b82692ca965a2aa7d07e12c92e8c6 (patch) | |
tree | 433c53e2840745a7dd71cd8c49ad1b8600f9a991 | |
parent | 5eb377ad8db716457b5750b54daa28b249006acd (diff) | |
download | guile-aa2d1143a05b82692ca965a2aa7d07e12c92e8c6.tar.gz |
Stylistic improvements for (ice-9 popen).
* module/ice-9/popen.scm (close-process, close-process-quietly): Accept
'port' and 'pid' as separate arguments. Improve style.
(close-pipe, read-pipes): Improve style.
-rw-r--r-- | module/ice-9/popen.scm | 45 |
1 files changed, 21 insertions, 24 deletions
diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 7d0549eb9..f8668cd51 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -74,27 +74,26 @@ port to the process is created: it should be the value of (hashq-remove! port/pid-table port) pid)) -(define (close-process port/pid) - (close-port (car port/pid)) - (cdr (waitpid (cdr port/pid)))) +(define (close-process port pid) + (close-port port) + (cdr (waitpid pid))) ;; for the background cleanup handler: just clean up without reporting ;; errors. also avoids blocking the process: if the child isn't ready ;; to be collected, puts it back into the guardian's live list so it ;; can be tried again the next time the cleanup runs. -(define (close-process-quietly port/pid) +(define (close-process-quietly port pid) (catch 'system-error (lambda () - (close-port (car port/pid))) + (close-port port)) (lambda args #f)) (catch 'system-error (lambda () - (let ((pid/status (waitpid (cdr port/pid) WNOHANG))) - (cond ((= (car pid/status) 0) - ;; not ready for collection - (pipe-guardian (car port/pid)) - (hashq-set! port/pid-table - (car port/pid) (cdr port/pid)))))) + (let ((pid/status (waitpid pid WNOHANG))) + (when (zero? (car pid/status)) + ;; not ready for collection + (pipe-guardian port) + (hashq-set! port/pid-table port pid)))) (lambda args #f))) (define (close-pipe p) @@ -102,19 +101,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (if (not pid) - (error "close-pipe: pipe not in table")) - (close-process (cons p pid)))) - -(define reap-pipes - (lambda () - (let loop ((p (pipe-guardian))) - (cond (p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (if pid - (close-process-quietly (cons p pid)))) - (loop (pipe-guardian))))))) + (unless pid (error "close-pipe: pipe not in table")) + (close-process p pid))) + +(define (reap-pipes) + (let loop () + (let ((p (pipe-guardian))) + (when p + ;; maybe removed already by close-pipe. + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid))) + (loop))))) (add-hook! after-gc-hook reap-pipes) |