From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 1 Oct 2004 04:01:58 +0000 (+0000)
Subject: r10072: new macros
X-Git-Tag: v1.96~49
X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=9e36114ec80a5a8b58a650a5f80b4d51b43d0ce0

r10072: new macros
---

diff --git a/macros.lisp b/macros.lisp
index c83b3b6..d0ba63c 100644
--- a/macros.lisp
+++ b/macros.lisp
@@ -264,8 +264,16 @@
      (format t "~%~%")
      (values)))
 
-(defmacro defconst (symbol value &optional doc)
-   `(defconstant ,symbol (if (boundp ',symbol)
-                             (symbol-value ',symbol)
-                             ,value)
+(defmacro defconstant* (sym value &optional doc)
+  "Ensure VALUE is evaluated only once."
+   `(defconstant ,sym (if (boundp ',sym)
+			  (symbol-value ',sym)
+			  ,value)
      ,@(when doc (list doc))))
+
+(defmacro defvar-unbound (sym &optional (doc ""))
+    "defvar with a documentation string."
+    `(progn
+      (defvar ,sym)
+      (setf (documentation ',sym 'variable) ,doc)))
+
diff --git a/package.lisp b/package.lisp
index 5f10fb9..80fa119 100644
--- a/package.lisp
+++ b/package.lisp
@@ -168,7 +168,8 @@
    #:def-cached-instance
    #:with-ignore-errors
    #:ppmx
-   #:defconst
+   #:defconstant*
+   #:defvar-unbound
    
    ;; files.lisp
    #:print-file-contents
diff --git a/strings.lisp b/strings.lisp
index a9b3d0f..fbb130c 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -416,9 +416,9 @@ for characters in a string"
   (declare (type (integer 0 15) n))
   (schar +hex-chars+ n))
 
-(defconst +char-code-lower-a+ (char-code #\a))
-(defconst +char-code-upper-a+ (char-code #\A))
-(defconst +char-code-0+ (char-code #\0))
+(defconstant* +char-code-lower-a+ (char-code #\a))
+(defconstant* +char-code-upper-a+ (char-code #\A))
+(defconstant* +char-code-0+ (char-code #\0))
 (declaim (type fixnum +char-code-0+ +char-code-upper-a+
 	       +char-code-0))
 
@@ -481,7 +481,7 @@ for characters in a string"
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar +unambiguous-charset+
     "abcdefghjkmnpqrstuvwxyz123456789ABCDEFGHJKLMNPQSRTUVWXYZ")
-  (defconstant +unambiguous-length+ (length +unambiguous-charset+)))
+  (defconstant* +unambiguous-length+ (length +unambiguous-charset+)))
 
 (defun random-char (&optional (set :lower-alpha))
   (ecase set