Safely mapping with backup

safe-map.lisp

(defun prompt-new-value (prompt)
  (format *query-io* prompt)  ;; *query-io*: the special stream to make user queries.
  (force-output *query-io*)   ;; Ensure the user sees what he types.
  (list (read *query-io*)))



(defun safe-map (predicate sequence &optional copy)
  (let ((backup (make-array 1 :adjustable t :fill-pointer 0)))
    (loop :for i :from 0 :below (length sequence)
          :do (vector-push-extend (if copy
                                      (funcall copy (elt sequence i))
                                      (elt sequence i))
                                  backup)
              (setf (elt sequence i)
                    (restart-case (funcall predicate (elt sequence i))
                      (use-value (value)
                        :report "Use another value"
                        :interactive (lambda ()
                                       (prompt-new-value "Please enter a new value: "))
                        (funcall predicate value))
                      (use-result (res)
                        :report "Enter a default result"
                        :interactive (lambda ()
                                       (prompt-new-value "Please enter a result: "))
                        res)
                      (restore-from-backup ()
                        :report "Restore original sequence from backup"
                        (loop :for j :from i :downto 0
                              :do (setf (elt sequence j) (aref backup j))
                              :finally (return-from safe-map sequence)))
                      (restore-using-function (function)
                        :report "Restore original sequence using function"
                        :interactive (lambda ()
                                       (prompt-new-value "Please enter a function name or a lambda: "))
                        (loop :for j :from i :downto 0
                              :do (setf (elt sequence j) (funcall function (elt sequence j)))
                              :finally (return-from safe-map sequence)))
                      (use-another-function (function)
                        :report "Use a different predicate"
                        :interactive (lambda ()
                                       (prompt-new-value "Please enter a predicate name or a lambda: "))
                        (progn (setf predicate function)
                               (funcall predicate (elt sequence i)))))))))