anchor.diff:      :type string))
     (:report (lambda (c s) (format s "NOT-IMPLEMENTED ~A~%" (not-implemented-message c)))))
   
  -(defclass fd-wrapper ()
  -  ((fd
  -    :initarg :fd
  -    :initform (required)
  -    :type (or null fixnum)
  -    :accessor fd)))
  -
  -(defclass pipe-fd (fd-wrapper)
  -  ((pipe
  -    :initarg :pipe
  -    :initform (required)
  -    :type communication-pipe)))
  -
  -(defmethod shared-initialize :around ((instance fd-wrapper) slots &key)
  -  (declare (ignore slots))
  -  (let ((result (call-next-method))
  -        (fd (slot-value instance 'fd)))
  -    (fd-is-managed fd)
  -    (cancel-finalization instance)
  -    (finalize instance
  -              (lambda ()
  -                (format *error-output* "GCCLOSE ~A~%" fd)
  -                (forget-managed-fd fd)
  -                (sb-posix:close fd)))
  -    result))
  -
  -(defun close-fd (the-fd)
  -  (with-slots (fd) the-fd
  -    (when fd
  -      (format *error-output* "CLOSE ~A~%" fd)
  -      (forget-managed-fd fd)
  -      (sb-posix:close fd)
  -      (setf fd nil)
  -      (cancel-finalization the-fd))))
  -
  -(defclass communication-pipe ()
  -  ((read-end
  -    :initform nil
  -    :type (or null pipe-fd)
  -    :accessor read-end)
  -   (write-end
  -    :initform nil
  -    :type (or null pipe-fd)
  -    :accessor write-end)))
  -
  -(defmethod shared-initialize :around ((pipe communication-pipe) slots &key)
  -  (let ((result (call-next-method)))
  -    (close-pipe pipe)
  -    (with-slots (read-end write-end) pipe
  -      (multiple-value-bind (fd-read-end fd-write-end) (sb-posix:pipe)
  -        (format *error-output* "PIPE ~A -> ~A~%" fd-write-end fd-read-end)
  -        (setf read-end (make-instance 'pipe-fd :pipe pipe :fd fd-read-end)
  -              write-end (make-instance 'pipe-fd :pipe pipe :fd fd-write-end))))
  -    result))
  -
  -(defun close-pipe (pipe)
  -  (with-slots (read-end write-end) pipe
  -    (when read-end
  -      (close-fd read-end)
  -      (setf read-end nil))
  -    (when write-end
  -      (close-fd write-end)
  -      (setf write-end nil))))
  -
  -(defmacro with-pipe ((variable-name) &body body)
  -  `(let ((,variable-name (make-instance 'communication-pipe)))
  -     (unwind-protect
  -          (progn ,@body)
  -       (close-pipe ,variable-name))))
  +(defparameter *fd-bindings* nil)
  +(defparameter *fds-in-scope* nil)
  +(defparameter *autoclosed-fds* nil)
  +
  +(defun autoclose-fd (fd)
  +  (push fd *autoclosed-fds*)
  +  (push fd *fds-in-scope*))
  +(defun autoclosed-fds ()
  +  *autoclosed-fds*)
  +
  +(defmacro with-fd-scope (() &body body)
  +  (let ((fd (gensym "FD")))
  +    `(let ((*fd-bindings* *fd-bindings*)
  +           (*autoclosed-fds* *autoclosed-fds*)
  +           *fds-in-scope*)
  +       (unwind-protect (progn ,@body)
  +         (dolist (,fd *fds-in-scope*)
  +           (format *error-output* "CLOSE ~A~%" ,fd)
  +           (sb-posix:close ,fd))))))
  +
  +(defmacro with-pipe ((read-end write-end) &body body)
  +  `(with-fd-scope ()
  +     (multiple-value-bind (,read-end ,write-end) (sb-posix:pipe)
  +       (format *error-output* "PIPE ~A -> ~A~%" write-end read-end)
  +       (autoclose-fd ,read-end)
  +       (autoclose-fd ,write-end)
  +       ,@body)))
   
   (defclass eval-thunk ()
     ())
  
positive.code: (defun process-from-pid (pid)
    (make-instance 'process :pid pid))
  
  (defclass pipeline-process (eval-thunk)
    ((processes)))
  
  (defun separator-par-p (separator)
    (check-type separator separator)
    (with-slots (separator-op) separator
      (when (slot-boundp separator 'separator-op)
        (typep separator-op 'par))))
  
  (defparameter *fd-bindings* (make-hash-table))
  
  (defparameter *fds-to-close-for-shadow* nil)
  
  (defparameter *managed-fds* (make-hash-table))
  (defun fd-is-managed (fd)
    (setf (gethash fd *managed-fds*) t))
  (defun forget-managed-fd (fd)
    (remhash fd *managed-fds*))
  (defun managed-fds ()
    (hash-table-keys *managed-fds*))
  
  (defmacro shadow-fd-bindings (&body body)
    (let ((fd (gensym "FD")))
      `(let ((*fd-bindings* (copy-hash-table *fd-bindings*))
             *fds-to-close-for-shadow*)
         (unwind-protect (progn ,@body)
           (dolist (,fd *fds-to-close-for-shadow*)
             (forget-managed-fd ,fd)
             (sb-posix:close ,fd))))))
  
  (defgeneric open-args-for-redirect (redirect))
  (defmethod open-args-for-redirect ((r less))
  
negative.code:   (:report (lambda (c s) (format s "Redirect from invalid fd: ~A~%" (invalid-fd-fd c)))))
  
  (defun get-fd (fd)
    (let ((binding (assoc fd *fd-bindings*)))
      (when binding
        (return-from get-fd (cdr binding))))
    (when (find fd (autoclosed-fds))
      (error 'invalid-fd :fd fd))
    (handler-case (sb-posix:fcntl fd sb-posix:f-getfd)
      (sb-posix:syscall-error ()
        (error 'invalid-fd :fd fd)))
    fd)
  
  (defgeneric handle-redirect (redirect &optional fd-override))
  
  