From e1d9e6c0422360ef61d5b1e5506fd953fd22ac39 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 4 Jun 1992 17:03:51 +0000
Subject: [PATCH] Fixed dispatch macro characters to be case-insensitive, and
 to disallow digits as sub-characters.

---
 code/reader.lisp | 35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

diff --git a/code/reader.lisp b/code/reader.lisp
index 514bc068a..714ba23bd 100644
--- a/code/reader.lisp
+++ b/code/reader.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.15 1992/05/15 17:51:49 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.16 1992/06/04 17:03:51 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1266,14 +1266,17 @@
 		 (push (cons char (make-char-dispatch-table)) dalist))))))
 
 (defun set-dispatch-macro-character
-  (disp-char sub-char function &optional (rt *readtable*))
+       (disp-char sub-char function &optional (rt *readtable*))
   "Causes function to be called whenever the reader reads
    disp-char followed by sub-char. Set-dispatch-macro-character
    returns T."
   ;;get the dispatch char for macro (error if not there), diddle
   ;;entry for sub-char.
-  (let ((dpair (find disp-char (dispatch-tables rt)
-		     :test #'char= :key #'car)))
+  (when (digit-char-p sub-char)
+    (error "Sub-Char must not be a decibal digit: ~S" sub-char))
+  (let* ((sub-char (char-upcase sub-char))
+	 (dpair (find disp-char (dispatch-tables rt)
+		      :test #'char= :key #'car)))
     (if dpair
 	(setf (elt (the simple-vector (cdr dpair))
 		   (char-code sub-char))
@@ -1282,14 +1285,16 @@
 
 (defun get-dispatch-macro-character (disp-char sub-char &optional rt)
   "Returns the macro character function for sub-char under disp-char
-  or nil if there is no associated function."
-  (let* ((rt (or rt *readtable*))
-	 (dpair (find disp-char (dispatch-tables rt)
-		      :test #'char= :key #'car)))
-    (if dpair
-	(elt (the simple-vector (cdr dpair))
-	     (char-code sub-char))
-	(error "~S is not a dispatch char." disp-char))))
+   or nil if there is no associated function."
+  (unless (digit-char-p sub-char)
+    (let* ((sub-char (char-upcase sub-char))
+	   (rt (or rt *readtable*))
+	   (dpair (find disp-char (dispatch-tables rt)
+			:test #'char= :key #'car)))
+      (if dpair
+	  (elt (the simple-vector (cdr dpair))
+	       (char-code sub-char))
+	  (error "~S is not a dispatch char." disp-char)))))
 
 (defun read-dispatch-char (stream char)
   ;;read some digits
@@ -1304,9 +1309,9 @@
 	  ;;take care of the extra char.
 	  (if (eofp ch)
 	      (reader-eof-error stream "inside dispatch character")
-	      (setq sub-char ch)))
-	 (setq numargp t)
-	 (setq numarg (+ (* numarg 10) dig)))
+	      (setq sub-char (char-upcase ch))))
+      (setq numargp t)
+      (setq numarg (+ (* numarg 10) dig)))
     ;;look up the function and call it.
     (let ((dpair (find char (dispatch-tables *readtable*)
 		       :test #'char= :key #'car)))
-- 
GitLab