definitions.lisp - clic - Clic is an command line interactive client for gopher… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
definitions.lisp (1656B) | |
--- | |
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 v… | |
17 ~S is not equal to the provided initial va… | |
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) document… | |
27 "Ensures that the global variable named by NAME is a constant with a v… | |
28 that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST… | |
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 n… | |
35 equal under TEST to result of evaluating INITIAL-VALUE." | |
36 `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test) | |
37 ,@(when documentation `(,documentation)))) |