definitions.lisp

   1 (in-package :alexandria)
   2
   3 (defun %reevaluate-constant (name value test)
   4   (if (not (boundp name))
   5       value
   6       (let ((old (symbol-value name))
   7             (new value))
   8         (if (not (constantp name))
   9             (prog1 new
  10               (cerror "Try to redefine the variable as a constant."
  11                       "~@<~S is an already bound non-constant variable ~
  12                        whose value is ~S.~:@>" name old))
  13             (if (funcall test old new)
  14                 old
  15                 (restart-case
  16                     (error "~@<~S is an already defined constant whose value ~
  17                               ~S is not equal to the provided initial value ~S ~
  18                               under ~S.~:@>" name old new test)
  19                   (ignore ()
  20                     :report "Retain the current value."
  21                     old)
  22                   (continue ()
  23                     :report "Try to redefine the constant."
  24                     new)))))))
  25
  26 (defmacro define-constant (name initial-value &key (test ''eql) documentation)
  27   "Ensures that the global variable named by NAME is a constant with a value
  28 that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST is a
  29 /function designator/ that defaults to EQL. If DOCUMENTATION is given, it
  30 becomes the documentation string of the constant.
  31
  32 Signals an error if NAME is already a bound non-constant variable.
  33
  34 Signals an error if NAME is already a constant variable whose value is not
  35 equal under TEST to result of evaluating INITIAL-VALUE."
  36   `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
  37      ,@(when documentation `(,documentation))))