commit f876164baffcb9161d1e75659146b4e7df971927 Spenser Truex <truex@equwal.com> 2025-09-02 22:17:20 -0700 Bring pipes from CLOCC to a standalone repo
README.md | 1 + package.lisp | 4 ++++ posix-pipes.asd | 10 +++++++++ posix-pipes.lisp | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 78 insertions(+)
diff --git a/README.md b/README.md new file mode 100644 index 0000000..3639550 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# posix-pipes diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..25641cb --- /dev/null +++ b/package.lisp @@ -0,0 +1,4 @@ +;;;; package.lisp + +(defpackage #:posix-pipes + (:use #:cl)) diff --git a/posix-pipes.asd b/posix-pipes.asd new file mode 100644 index 0000000..f99c8b1 --- /dev/null +++ b/posix-pipes.asd @@ -0,0 +1,10 @@ +;;;; posix-pipes.asd + +(asdf:defsystem #:posix-pipes + :description "Describe posix-pipes here" + :author "Spenser Truex <truex@equwal.com>" + :license "LGPL" + :version "0.0.1" + :serial t + :components ((:file "package") + (:file "posix-pipes"))) diff --git a/posix-pipes.lisp b/posix-pipes.lisp new file mode 100644 index 0000000..5661e75 --- /dev/null +++ b/posix-pipes.lisp @@ -0,0 +1,63 @@ +;;;; pulled straight from CLOCC + +(in-package #:posix-pipes) + +(defun pipe-output (prog &rest args) + "Return an output stream which will go to the command." + #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args) + :input :stream :wait nil) + #+clisp (ext:make-pipe-output-stream (format nil "~a~{ ~a~}" prog args)) + #+cmu (ext:process-input (ext:run-program prog args :input :stream + :output t :wait nil)) + #+gcl (si::fp-input-stream (apply #'si:run-process prog args)) + #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args) + :direction :output) + #+lucid (lcl:run-program prog :arguments args :wait nil :output :stream) + #+sbcl (sb-ext:process-input (sb-ext:run-program prog args :input :stream + :output t :wait nil)) + #-(or allegro clisp cmu gcl lispworks lucid sbcl) + (error 'not-implemented :proc (list 'pipe-output prog args))) + +(defun pipe-input (prog &rest args) + "Return an input stream from which the command output will be read." + #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args) + :output :stream :wait nil) + #+clisp (ext:make-pipe-input-stream (format nil "~a~{ ~a~}" prog args)) + #+cmu (ext:process-output (ext:run-program prog args :output :stream + :error t :input t :wait nil)) + #+gcl (si::fp-output-stream (apply #'si:run-process prog args)) + #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args) + :direction :input) + #+lucid (lcl:run-program prog :arguments args :wait nil :input :stream) + #+sbcl (sb-ext:process-output (sb-ext:run-program prog args :output :stream + :error t :input t :wait nil)) + #-(or allegro clisp cmu gcl lispworks lucid sbcl) + (error 'not-implemented :proc (list 'pipe-input prog args))) + +;;; Allegro CL: a simple `close' does NOT get rid of the process. +;;; The right way, of course, is to define a Gray stream `pipe-stream', +;;; define the `close' method and use `with-open-stream'. +;;; Unfortunately, not every implementation supports Gray streams, so we +;;; have to stick with this to further the portability. +;;; [2005] actually, all implementations support Gray streams (see gray.lisp) +;;; but Gray streams may be implemented inefficiently + +(defun close-pipe (stream) + "Close the pipe stream." + (declare (stream stream)) + (close stream) + ;; CLOSE does not close constituent streams + ;; CLOSE-CONSTRUCTED-STREAM:ARGUMENT-STREAM-ONLY + ;; http://www.lisp.org/HyperSpec/Issues/iss052.html + (typecase stream + (two-way-stream + (close (two-way-stream-input-stream stream)) + (close (two-way-stream-output-stream stream)))) + #+allegro (sys:reap-os-subprocess)) + +(defmacro with-open-pipe ((pipe open) &body body) + "Open the pipe, do something, then close it." + `(let ((,pipe ,open)) + (declare (stream ,pipe)) + (unwind-protect (progn ,@body) + (close-pipe ,pipe))))