Port scsh-process to CHICKEN 5

Thanks to Vasilij Schneidermann for providing an initial patch.

1 files changed, 22 insertions, 7 deletions

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 ;;