r10072: new macros

diff --git a/macros.lisp b/macros.lisp
index c83b3b64a19f9f9be26f9dd96daa9ed9213f6f6d..d0ba63c629d8e698cc011c6072ce82c20e7d604d 100644 (file)
--- a/macros.lisp
+++ b/macros.lisp
@@ -264,8 +264,16 @@
      (format t "~%~%")
      (values)))
 
      (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))))
      ,@(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 5f10fb9a8071370d3de7d415d2e49e68dc351cde..80fa1190ef066f420157812420b5d24831adbbaf 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -168,7 +168,8 @@
    #:def-cached-instance
    #:with-ignore-errors
    #:ppmx
    #:def-cached-instance
    #:with-ignore-errors
    #:ppmx

-   #:defconst
+   #:defconstant*
+   #:defvar-unbound

    
    ;; files.lisp
    #:print-file-contents
    
    ;; files.lisp
    #:print-file-contents

diff --git a/strings.lisp b/strings.lisp
index a9b3d0f9b320a95126b206348e852d812ea8a9b2..fbb130caad55b5d4442653f43d1d57290354bd4a 100644 (file)
--- 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))
 
   (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))
 
 (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")
 (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
 
 (defun random-char (&optional (set :lower-alpha))
   (ecase set