From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 14 Apr 2008 09:32:08 +0000 (+0100)
Subject: Fix constant-resetting.
X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/commitdiff_plain/d6caa73bc6253f7a0461406a939865a207bad7c8

Fix constant-resetting.

There's a new macro defconstant* which checks a predicate before
actually resetting.  But alas the only offender is in infix.lisp, for
which we have a policy of not requiring external dependencies, so I've
expanded the macro by hand.
---

diff --git a/infix.lisp b/infix.lisp
index 64a0a30..a77f51e 100644
--- a/infix.lisp
+++ b/infix.lisp
@@ -94,8 +94,12 @@
 ;;;--------------------------------------------------------------------------
 ;;; The tokenizer.
 
-(defconstant eof (cons :eof nil)
-  "A magical object which `get-token' returns at end-of-file.")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (let ((value (cons :eof nil)))
+    (unless (and (boundp 'eof)
+		 (equal (symbol-value 'eof) value))
+      (defconstant eof (cons :eof nil)
+	"A magical object which `get-token' returns at end-of-file."))))
 
 (defun default-get-token ()
   "Read a token from *stream* and store it in *token*."
diff --git a/mdw-base.lisp b/mdw-base.lisp
index 2c1a79c..a41b685 100644
--- a/mdw-base.lisp
+++ b/mdw-base.lisp
@@ -135,6 +135,17 @@
        t)
     (t nil)))
 
+(defmacro defconstant* (name value &key doc test)
+  "Define a constant, like `defconstant'.  The TEST is an equality test used
+   to decide whether to override the current definition, if any."
+  (let ((temp (gensym)))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (let ((,temp ,value))
+	 (unless (and (boundp ',name)
+		      (funcall ,(or test ''eql) (symbol-value ',name) ,temp))
+	   (defconstant ,name ,value ,@(and doc (list doc))))
+	 ',name))))
+
 (declaim (ftype (function nil ()) slot-unitialized))
 (defun slot-uninitialized ()
   "A function which signals an error.  Can be used as an initializer form in