Signal an error if the readtable case of the standard readtable is
authorRaymond Toy <toy.raymond@gmail.com>
Sun, 24 Feb 2013 04:44:23 +0000 (20:44 -0800)
committerRaymond Toy <toy.raymond@gmail.com>
Sun, 24 Feb 2013 04:44:23 +0000 (20:44 -0800)
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

index 3b4d06b..4eabc4e 100644 (file)
   ;; 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
     (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)