[Chicken-hackers] [PATCH 7/8] Add chicken.process module

[Evan Hanson]

This module reexports all process-related procedures from the posix
unit, as well as `qs` and `system*` from utils. The former procedure has
been tweaked to avoid a dependency on `string-intersperse` from the
data-structures unit, while the latter has been modified so as not to
"sprintf" its arguments.
---
 README                |  1 +
 chicken-install.scm   |  1 +
 defaults.make         |  4 ++--
 distribution/manifest |  2 ++
 manual/Unit posix     | 21 +++++++++++++++++++++
 manual/Unit utils     | 25 -------------------------
 posix.scm             | 37 +++++++++++++++++++++++++++++++++++++
 rules.make            |  5 ++++-
 tests/runtests.sh     |  1 +
 utils.scm             | 30 +-----------------------------
 10 files changed, 70 insertions(+), 57 deletions(-)

diff --git a/README b/README
index 9d960704..c242fc91 100644
--- a/README
+++ b/README
@@ -301,6 +301,7 @@
        |   |       |-- chicken.port.import.so
        |   |       |-- chicken.posix.import.so
        |   |       |-- chicken.pretty-print.import.so
+       |   |       |-- chicken.process.import.so
        |   |       |-- chicken.random.import.so
        |   |       |-- chicken.repl.import.so
        |   |       |-- chicken.read-syntax.import.so
diff --git a/chicken-install.scm b/chicken-install.scm
index e097e150..754c456b 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -71,6 +71,7 @@
       "chicken.port.import.so"
       "chicken.posix.import.so"
       "chicken.pretty-print.import.so"
+      "chicken.process.import.so"
       "chicken.random.import.so"
       "chicken.repl.import.so"
       "chicken.read-syntax.import.so"
diff --git a/defaults.make b/defaults.make
index d49ebccb..d0e5f18b 100644
--- a/defaults.make
+++ b/defaults.make
@@ -266,8 +266,8 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
 PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.csi chicken.foreign
 DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
 DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix fixnum flonum \
-       format gc io keyword locative memory posix pretty-print random \
-       time time.posix
+       format gc io keyword locative memory posix pretty-print process \
+       random time time.posix
 DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
 DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
        eval expand file files internal irregex lolevel pathname port \
diff --git a/distribution/manifest b/distribution/manifest
index 36357bb0..5f7e9ed2 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -317,6 +317,8 @@ chicken.posix.import.scm
 chicken.posix.import.c
 chicken.pretty-print.import.scm
 chicken.pretty-print.import.c
+chicken.process.import.scm
+chicken.process.import.c
 chicken.random.import.scm
 chicken.random.import.c
 chicken.read-syntax.import.scm
diff --git a/manual/Unit posix b/manual/Unit posix
index a79894e8..50586d67 100644
--- a/manual/Unit posix 
+++ b/manual/Unit posix 
@@ -760,6 +760,27 @@ Creates a new session if the calling process is not a 
process group leader and r
 the session ID.
 
 
+=== Shell commands
+
+==== system*
+
+<procedure>(system* STRING)</procedure>
+
+Similar to {{(system STRING)}}, but signals an error should the invoked
+program return a nonzero exit status.
+
+==== qs
+
+<procedure>(qs STRING [PLATFORM])</procedure>
+
+Escapes {{STRING}} suitably for passing to a shell command on {{PLATFORM}}.
+{{PLATFORM}} defaults to the value of {{(build-platform)}} and indicates in
+which style the argument should be quoted. On Windows systems, the string
+is simply enclosed in double-quote ({{"}}) characters, on UNIXish systems,
+characters that would have a special meaning to the shell are escaped
+using backslash ({{\}}).
+
+
 === Hard and symbolic links
 
 ==== symbolic-link?
diff --git a/manual/Unit utils b/manual/Unit utils
index 31108c5c..c299b79f 100644
--- a/manual/Unit utils 
+++ b/manual/Unit utils 
@@ -11,31 +11,6 @@ extras|extras]] unit).
 This unit uses the {{extras}} unit.
 
 
-=== Executing shell commands with formatstring and error checking
-
-==== system*
-
-<procedure>(system* FORMATSTRING ARGUMENT1 ...)</procedure>
-
-Similar to {{(system (sprintf FORMATSTRING ARGUMENT1 ...))}},
-but signals an error should the invoked program return a nonzero
-exit status.
-
-
-=== Shell argument quoting
-
-==== qs
-
-<procedure>(qs STRING [PLATFORM])</procedure>
-
-Escapes {{STRING}} suitably for passing to a shell command on {{PLATFORM}}.
-{{PLATFORM}} defaults to the value of {{(build-platform)}} and indicates in
-which style the argument should be quoted. On Windows systems, the string
-is simply enclosed in double-quote ({{"}}) characters, on UNIXish systems,
-characters that would have a special meaning to the shell are escaped
-using backslash ({{\}}).
-
-
 === Dynamic compilation
 
 ==== compile-file
diff --git a/posix.scm b/posix.scm
index 1fc11d42..d403c3d4 100644
--- a/posix.scm
+++ b/posix.scm
@@ -109,3 +109,40 @@
    seconds->string local-time->seconds string->time time->string
    local-timezone-abbreviation)
 (import chicken chicken.posix))
+
+(module chicken.process
+  (qs system system* process-execute process-fork process-run
+   process-signal process-wait call-with-input-pipe
+   call-with-output-pipe close-input-pipe close-output-pipe create-pipe
+   open-input-pipe open-output-pipe with-input-from-pipe
+   with-output-to-pipe process process* pipe/buf process-group-id
+   create-session)
+
+(import chicken scheme chicken.posix)
+
+
+;;; Like `system', but bombs on nonzero return code:
+
+(define (system* str)
+  (let ((n (system str)))
+    (unless (zero? n)
+      (##sys#error "shell invocation failed with non-zero return status" str 
n))))
+
+
+;;; Quote string for shell:
+
+(define (qs str #!optional (platform (build-platform)))
+  (let* ((delim (if (eq? platform 'mingw32) #\" #\'))
+        (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''"))
+        (escaped-parts
+         (map (lambda (c)
+                (cond
+                  ((char=? c delim) escaped)
+                  ((char=? c #\nul)
+                   (error 'qs "NUL character can not be represented in shell 
string" str))
+                  (else (string c))))
+              (string->list str))))
+    (string-append
+     (string delim)
+     (apply string-append escaped-parts)
+     (string delim)))))
diff --git a/rules.make b/rules.make
index a9c200a4..ba99cb6e 100644
--- a/rules.make
+++ b/rules.make
@@ -522,6 +522,7 @@ $(eval $(call 
declare-emitted-import-lib-dependency,chicken.posix,$(POSIXFILE)))
 $(eval $(call 
declare-emitted-import-lib-dependency,chicken.errno,$(POSIXFILE)))
 $(eval $(call 
declare-emitted-import-lib-dependency,chicken.file.posix,$(POSIXFILE)))
 $(eval $(call 
declare-emitted-import-lib-dependency,chicken.time.posix,$(POSIXFILE)))
+$(eval $(call 
declare-emitted-import-lib-dependency,chicken.process,$(POSIXFILE)))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.fixnum,library))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
@@ -772,7 +773,7 @@ utils.c: utils.scm \
                chicken.foreign.import.scm \
                chicken.format.import.scm \
                chicken.pathname.import.scm \
-               chicken.posix.import.scm
+               chicken.process.import.scm
 
 define profile-flags
 $(if $(filter $(basename $(1)),$(PROFILE_OBJECTS)),-profile)
@@ -811,12 +812,14 @@ posixunix.c: $(SRCDIR)posix.scm $(SRCDIR)posixunix.scm 
$(SRCDIR)posix-common.scm
        -emit-import-library chicken.errno \
        -emit-import-library chicken.file.posix \
        -emit-import-library chicken.time.posix \
+       -emit-import-library chicken.process \
        -emit-import-library chicken.posix
 posixwin.c: $(SRCDIR)posix.scm $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm 
$(SRCDIR)common-declarations.scm
        $(bootstrap-lib) -feature platform-windows \
        -emit-import-library chicken.errno \
        -emit-import-library chicken.file.posix \
        -emit-import-library chicken.time.posix \
+       -emit-import-library chicken.process \
        -emit-import-library chicken.posix
 irregex.c: $(SRCDIR)irregex.scm $(SRCDIR)irregex-core.scm 
$(SRCDIR)irregex-utils.scm $(SRCDIR)common-declarations.scm
        $(bootstrap-lib) -emit-import-library chicken.irregex
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 644683e0..84bbe7b8 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -59,6 +59,7 @@ for x in \
     chicken.port.import.so \
     chicken.posix.import.so \
     chicken.pretty-print.import.so \
+    chicken.process.import.so \
     chicken.random.import.so \
     chicken.repl.import.so \
     chicken.read-syntax.import.so \
diff --git a/utils.scm b/utils.scm
index 05c7d101..ae92e89e 100644
--- a/utils.scm
+++ b/utils.scm
@@ -43,39 +43,11 @@
        chicken.foreign
        chicken.format
        chicken.pathname
-       chicken.posix)
+       chicken.process)
 
 (include "common-declarations.scm")
 
 
-;;; Like `system', but allows format-string and bombs on nonzero return code:
-
-(define system*
-  (lambda (fstr . args)
-    (let* ([str (apply sprintf fstr args)]
-          [n (system str)] )
-      (unless (zero? n)
-       (##sys#error "shell invocation failed with non-zero return status" str 
n) ) ) ) )
-
-
-;;; Quote string for shell
-
-(define (qs str #!optional (platform (build-platform)))
-  (let ((delim (if (eq? platform 'mingw32) #\" #\'))
-       (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''")))
-    (string-append
-     (string delim)
-     (string-intersperse
-      (map (lambda (c)
-            (cond
-             ((char=? c delim) escaped)
-             ((char=? c #\nul) (error 'qs "NUL character can not be 
represented in shell string" str))
-             (else (string c))))
-          (string->list str))
-      "")
-     (string delim))))
-
-
 ;;; Compile and load file
 
 (define compile-file-options (make-parameter '("-O2" "-d2")))
-- 
2.11.0