3rdparties/software/alexandria-20200427-git/alexandria-1/definitions.lisp (1656 bytes)
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))))