r10072: new macros
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 1 Oct 2004 04:01:58 +0000 (04:01 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 1 Oct 2004 04:01:58 +0000 (04:01 +0000)
macros.lisp
package.lisp
strings.lisp

index c83b3b6..d0ba63c 100644 (file)
      (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)))
+
index 5f10fb9..80fa119 100644 (file)
    #:def-cached-instance
    #:with-ignore-errors
    #:ppmx
-   #:defconst
+   #:defconstant*
+   #:defvar-unbound
    
    ;; files.lisp
    #:print-file-contents
index a9b3d0f..fbb130c 100644 (file)
@@ -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