definitions.lisp

   1 (in-package :alexandria)
   2
   3 (defun %reevaluate-constant (name value &key (test 'eql))
   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                 (prog1 new
  16                   (cerror "Try to redefine the constant."
  17                           "~@<~S is an already defined constant whose value ~
  18                            ~S is not equal to the provided initial value ~S ~
  19                            under ~S.~:@>" name old new test)))))))
  20
  21 (defmacro define-constant (name initial-value &key (test ''eql) documentation)
  22   "Ensures that the global variable named by NAME is a constant with a
  23 value that is equal under TEST to the result of evaluating
  24 INITIAL-VALUE. TEST is a /function designator/ that defaults to
  25 EQL. If DOCUMENTATION is given, it becomes the documentation string of
  26 the constant.
  27
  28 Signals an error if NAME is already a bound non-constant variable.
  29
  30 Signals an error if NAME is already a constant variable whose value is not
  31 equal under TEST to result of evaluating INITIAL-VALUE."
  32   `(defconstant ,name (%reevaluate-constant ',name
  33                                             ,initial-value
  34                                             :test ,test)
  35      ,@(when documentation `(,documentation))))