From 10859380420e467d96a57a95f267c46320a6f57c Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sat, 23 Feb 2013 20:44:23 -0800 Subject: [PATCH] Signal an error if the readtable case of the standard readtable is changed. * Rename the slot to %READTABLE-CASE (from READTABLE-CASE). * Add READTABLE-CASE and (SETF READTABLE-CASE) functions, as required. * Check for the standard readtable in (SETF READTABLE-CASE). --- src/code/reader.lisp | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 3b4d06bec..4eabc4e13 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -144,7 +144,7 @@ ;; vectors of CHAR-CODE-LIMIT functions, for use in defining dispatching ;; macros (like #-macro). (dispatch-tables () :type list) - (readtable-case :upcase :type (member :upcase :downcase :preserve :invert)) + (%readtable-case :upcase :type (member :upcase :downcase :preserve :invert)) ;; ;; The CHARACTER-ATTRIBUTE-HASH-TABLE handles the case of char codes ;; above ATTRIBUTE-TABLE-LIMIT, since we expect these to be @@ -466,6 +466,13 @@ (cerror "Modify it anyway." 'kernel:standard-readtable-modified-error :operation operation))) +(defun readtable-case (table) + (%readtable-case table)) + +(defun (setf readtable-case) (new-case table) + (assert-not-standard-readtable table '(setf readtable-case)) + (setf (%readtable-case table) new-case)) + (defun copy-readtable (&optional (from-readtable *readtable*) to-readtable) "A copy is made of from-readtable and place into to-readtable." (assert-not-standard-readtable to-readtable 'copy-readtable) -- GitLab