From eaf6f3001b1956f8b93d58815116b8977c029c47 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 27 Mar 2021 20:44:28 -0700 Subject: APPLY-AND-PRINT: propagate :NO-CHANGE Signed-off-by: Sean Whitton --- src/combinator.lisp | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/combinator.lisp b/src/combinator.lisp index 0806e45..8c7a14b 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -78,21 +78,24 @@ apply the elements of REQUIREMENTS in reverse order." ;; note that the :FAILED-CHANGE value is only used within this function and ;; should not be returned by property subroutines, per the spec (defun apply-and-print (propapps &optional unapply) - (dolist (pa (if unapply (reverse propapps) propapps)) - ;; TODO Nested combinators can mean that we establish this restart more - ;; than once, and they all appear in the debugger without any way to - ;; distinguish them. Perhaps we can use the :TEST argument to - ;; RESTART-CASE such that only the innermost(?) skip option appears. - (let* ((result (restart-case - (with-indented-inform - (if unapply (propappunapply pa) (propappapply pa))) - (skip-property () :failed-change))) - (status (case result - (:no-change "ok") - (:failed-change "failed") - (t "done")))) - (informat t "~&~@[~A :: ~]~@[~A ... ~]~A~%" - (get-hostname) (propappdesc pa) status)))) + (let ((ret :no-change)) + (dolist (pa (if unapply (reverse propapps) propapps) ret) + ;; TODO Nested combinators can mean that we establish this restart more + ;; than once, and they all appear in the debugger without any way to + ;; distinguish them. Perhaps we can use the :TEST argument to + ;; RESTART-CASE such that only the innermost(?) skip option appears. + (let* ((result (restart-case + (with-indented-inform + (if unapply (propappunapply pa) (propappapply pa))) + (skip-property () :failed-change))) + (status (case result + (:no-change "ok") + (:failed-change "failed") + (t "done")))) + (informat t "~&~@[~A :: ~]~@[~A ... ~]~A~%" + (get-hostname) (propappdesc pa) status) + (unless (or (not ret) (eq result :no-change)) + (setq ret nil)))))) (define-function-property-combinator unapply (propapp) (destructuring-bind (psym . args) propapp -- cgit v1.2.3