summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-11-17 02:46:08 -0500
committerMark H Weaver <mhw@netris.org>2013-11-17 04:54:04 -0500
commitaa2d1143a05b82692ca965a2aa7d07e12c92e8c6 (patch)
tree433c53e2840745a7dd71cd8c49ad1b8600f9a991
parent5eb377ad8db716457b5750b54daa28b249006acd (diff)
downloadguile-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.scm45
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)