From 9e60a56810770cb0f3f3471b272c15e114dce57d Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 2 Jun 2008 11:48:26 +0300
Subject: [PATCH] additional restart for DEFINE-CONSTANT

---
 definitions.lisp | 30 ++++++++++++++++--------------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/definitions.lisp b/definitions.lisp
index d1db72d..863e1f6 100644
--- a/definitions.lisp
+++ b/definitions.lisp
@@ -1,6 +1,6 @@
 (in-package :alexandria)
 
-(defun %reevaluate-constant (name value &key (test 'eql))
+(defun %reevaluate-constant (name value test)
   (if (not (boundp name))
       value
       (let ((old (symbol-value name))
@@ -12,24 +12,26 @@
                        whose value is ~S.~:@>" name old))
             (if (funcall test old new)
                 old
-                (prog1 new
-                  (cerror "Try to redefine the constant."
-                          "~@<~S is an already defined constant whose value ~
-                           ~S is not equal to the provided initial value ~S ~
-                           under ~S.~:@>" name old new test)))))))
+                (restart-case
+                    (error "~@<~S is an already defined constant whose value ~
+                              ~S is not equal to the provided initial value ~S ~
+                              under ~S.~:@>" name old new test)
+                  (ignore ()
+                    :report "Retain the current value."
+                    old)
+                  (continue ()
+                    :report "Try to redefine the constant."
+                    new)))))))
 
 (defmacro define-constant (name initial-value &key (test ''eql) documentation)
-  "Ensures that the global variable named by NAME is a constant with a
-value that is equal under TEST to the result of evaluating
-INITIAL-VALUE. TEST is a /function designator/ that defaults to
-EQL. If DOCUMENTATION is given, it becomes the documentation string of
-the constant.
+  "Ensures that the global variable named by NAME is a constant with a value
+that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST is a
+/function designator/ that defaults to EQL. If DOCUMENTATION is given, it
+becomes the documentation string of the constant.
 
 Signals an error if NAME is already a bound non-constant variable.
 
 Signals an error if NAME is already a constant variable whose value is not
 equal under TEST to result of evaluating INITIAL-VALUE."
-  `(defconstant ,name (%reevaluate-constant ',name
-                                            ,initial-value
-                                            :test ,test)
+  `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
      ,@(when documentation `(,documentation))))
-- 
2.11.4.GIT