Skip to content
Snippets Groups Projects
Commit 9e60a568 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

additional restart for DEFINE-CONSTANT

parent 5ec9ae72
No related branches found
No related tags found
No related merge requests found
(in-package :alexandria) (in-package :alexandria)
(defun %reevaluate-constant (name value &key (test 'eql)) (defun %reevaluate-constant (name value test)
(if (not (boundp name)) (if (not (boundp name))
value value
(let ((old (symbol-value name)) (let ((old (symbol-value name))
...@@ -12,24 +12,26 @@ ...@@ -12,24 +12,26 @@
whose value is ~S.~:@>" name old)) whose value is ~S.~:@>" name old))
(if (funcall test old new) (if (funcall test old new)
old old
(prog1 new (restart-case
(cerror "Try to redefine the constant." (error "~@<~S is an already defined constant whose value ~
"~@<~S is an already defined constant whose value ~ ~S is not equal to the provided initial value ~S ~
~S is not equal to the provided initial value ~S ~ under ~S.~:@>" name old new test)
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) (defmacro define-constant (name initial-value &key (test ''eql) documentation)
"Ensures that the global variable named by NAME is a constant with a "Ensures that the global variable named by NAME is a constant with a value
value that is equal under TEST to the result of evaluating that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST is a
INITIAL-VALUE. TEST is a /function designator/ that defaults to /function designator/ that defaults to EQL. If DOCUMENTATION is given, it
EQL. If DOCUMENTATION is given, it becomes the documentation string of becomes the documentation string of the constant.
the constant.
Signals an error if NAME is already a bound non-constant variable. 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 Signals an error if NAME is already a constant variable whose value is not
equal under TEST to result of evaluating INITIAL-VALUE." equal under TEST to result of evaluating INITIAL-VALUE."
`(defconstant ,name (%reevaluate-constant ',name `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
,initial-value
:test ,test)
,@(when documentation `(,documentation)))) ,@(when documentation `(,documentation))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment