From dd7d5a27716ca0c02314487711f6a9cb32731440 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Thu, 16 Aug 2018 22:41:12 +0200 Subject: Port scsh-process to CHICKEN 5 Thanks to Vasilij Schneidermann for providing an initial patch. --- scsh-process.scm | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) (limited to 'scsh-process.scm') diff --git a/scsh-process.scm b/scsh-process.scm index f675a2c..596a6b5 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -52,9 +52,17 @@ process? proc:pid proc? wait signal-process process-sleep) -(import chicken scheme data-structures) - -(use extras utils files ports posix srfi-1 srfi-18 srfi-69) +(import scheme) + +(cond-expand + (chicken-5 (import (chicken base) (chicken condition) (chicken io) + (chicken port) (chicken file) (chicken file posix) + (chicken string) + (chicken process) (chicken process signal) + srfi-18 srfi-69)) + (else (import chicken) + (use data-structures (rename extras (read-file read-list)) + utils files ports posix srfi-1 srfi-18 srfi-69))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; Process bookkeeping ;; @@ -272,8 +280,11 @@ (define (fork/pipe+ conns #!optional thunk continue-threads?) ;; Blergh, this is silly overhead we don't really need - (let* ((from-fds (map (lambda (x) (drop-right x 1)) conns)) - (to-fds (map last conns)) + (let* ((revconns (map reverse conns)) + ;; from-fds is everything but the last, to-fds the last of + ;; each connection spec. + (from-fds (map (lambda (x) (reverse (cdr x))) revconns)) + (to-fds (map car revconns)) (pipe-pairs (map (lambda _ (receive (create-pipe))) to-fds)) (proc (fork #f continue-threads?))) (if (not proc) ; Child @@ -356,13 +367,17 @@ (lambda () (close-input-port in))))) (define (run/string* thunk) - (call-with-run/port* thunk (lambda (in) (read-string #f in)))) + (call-with-run/port* thunk (lambda (in) + (let ((result (read-string #f in))) + (if (eof-object? result) + "" + result))))) (define (run/strings* thunk) (call-with-run/port* thunk read-lines)) (define (run/sexp* thunk) (call-with-run/port* thunk read)) (define (run/sexps* thunk) - (call-with-run/port* thunk read-file)) + (call-with-run/port* thunk read-list)) ;;;;;;;;;;;; ;; Syntax ;; -- cgit v1.2.3