file-io

(defun collect-objects
  (list channel state)
  (mv-let (eofp obj state)
    (read-object channel state)
    (if eofp
      (mv (reverse list) state)
      (collect-objects (cons obj list) channel state))))

(defun read-list
  (fname ctx state)
  (mv-let (channel state)
    (open-input-channel fname :object state)
    (if channel
      (mv-let (result state)
        (collect-objects nil channel state)
        (let ((state (close-input-channel channel state)))
          (value result)))
      (er soft
        ctx
        "Unable to open file ~s0 for :object input."
        fname))))

(defun pprint-object-or-string
  (obj channel state)
  (if (stringp obj)
    (princ$ obj channel state)
    (mv-let (erp val state)
      (state-global-let* ((write-for-read t))
        (pprogn (ppr2 (ppr1 obj (print-base) (print-radix) 80 0 state t)
            0
            channel
            state
            t)
          (value nil)))
      (declare (ignore erp val))
      state)))

(defun write-objects
  (list channel state)
  (if (consp list)
    (pprogn (pprint-object-or-string (car list) channel state)
      (newline channel state)
      (newline channel state)
      (write-objects (cdr list) channel state))
    state))

(defun write-list-body-fn
  (bangp quietp)
  `(let ((quietp ,QUIETP))
    (if (not (stringp fname))
      (er soft
        ctx
        "The filename argument of write-list must evaluate to a string, ~
              but it has evaluated to ~x0.  See :DOC write-list."
        fname)
      (mv-let (channel state)
        ,(IF BANGP
     '(OPEN-OUTPUT-CHANNEL! FNAME :CHARACTER STATE)
     '(OPEN-OUTPUT-CHANNEL FNAME :CHARACTER STATE))
        (if channel
          (mv-let (col state)
            (cond (quietp (mv 0 state))
              (t (fmt1 "Writing file ~x0~%"
                  (list (cons #\0 fname))
                  0
                  (standard-co state)
                  state
                  nil)))
            (declare (ignore col))
            (let ((state (write-objects list channel state)))
              (pprogn (close-output-channel channel state)
                (value :invisible))))
          (er soft
            ctx
            "Unable to open file ~s0 for :character output."
            fname))))))

(defun write-list-fn
  (list fname ctx state quiet)
  (if quiet
    (write-list-body nil t)
    (write-list-body nil nil)))