>>>>> "dm" == Drew McDermott <[EMAIL PROTECTED]> writes:
dm> If I load a file more than once, and it contains a call to
dm> make-dispatch-macro-character, the following error occurs on all loads
dm> after the first:
dm>
dm> * (make-dispatch-macro-character #\! t ytools-readtable*)
dm> Error in function MAKE-DISPATCH-MACRO-CHARACTER:
dm> Dispatch character already exists
dm> The Hyperspec seems to imply that there are no "exceptional
dm> situations" associated with make-dispatch-macro-character. Allegro
dm> doesn't signal an error in this situation.
the following patch changes CMUCL's behaviour in this situation, so
that it doesn't signal an error.
Index: code/reader.lisp
===================================================================
RCS file: /net/dukas/l1/emarsden/src/CVS-cmucl/src/code/reader.lisp,v
retrieving revision 1.32
diff -c -u -F^( -r1.32 reader.lisp
--- code/reader.lisp 25 Jul 2002 14:49:25 -0000 1.32
+++ code/reader.lisp 24 Sep 2002 17:54:04 -0000
@@ -1364,13 +1364,9 @@ (defun make-dispatch-macro-character (ch
flag is set to T, the char will be non-terminating. Make-dispatch-
macro-character returns T."
(set-macro-character char #'read-dispatch-char non-terminating-p rt)
- (let* ((dalist (dispatch-tables rt))
- (dtable (cdr (find char dalist :test #'char= :key #'car))))
- (cond (dtable
- (error "Dispatch character already exists"))
- (t
- (setf (dispatch-tables rt)
- (push (cons char (make-char-dispatch-table)) dalist))))))
+ (let ((dalist (dispatch-tables rt)))
+ (setf (dispatch-tables rt)
+ (push (cons char (make-char-dispatch-table)) dalist))))
(defun set-dispatch-macro-character
(disp-char sub-char function &optional (rt *readtable*))
@@ -1380,7 +1376,7 @@ (defun set-dispatch-macro-character
;;get the dispatch char for macro (error if not there), diddle
;;entry for sub-char.
(when (digit-char-p sub-char)
- (error "Sub-Char must not be a decimal digit: ~S" sub-char))
+ (simple-program-error "Sub-Char must not be a decimal digit: ~S" sub-char))
(let* ((sub-char (char-upcase sub-char))
(dpair (find disp-char (dispatch-tables rt)
:test #'char= :key #'car)))
@@ -1388,7 +1384,7 @@ (defun set-dispatch-macro-character
(setf (elt (the simple-vector (cdr dpair))
(char-code sub-char))
(coerce function 'function))
- (error "~S is not a dispatch character." disp-char))))
+ (simple-program-error "~S is not a dispatch character." disp-char))))
(defun get-dispatch-macro-character
(disp-char sub-char &optional (rt *readtable*))
@@ -1402,7 +1398,7 @@ (defun get-dispatch-macro-character
(if dpair
(elt (the simple-vector (cdr dpair))
(char-code sub-char))
- (error "~S is not a dispatch char." disp-char)))))
+ (simple-program-error "~S is not a dispatch character." disp-char)))))
(defun read-dispatch-char (stream char)
;;read some digits
--
Eric Marsden <URL:http://www.laas.fr/~emarsden/>
