1.0.48.13: SET-SYNTAX-FROM-CHAR and dispatch-macro characterness

[sbcl.git] / src / code / reader.lisp

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 6ae6ce4..56b8ac1 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -250,17 +250,19 @@ standard Lisp readtable when NIL."
                           :test #'char= :key #'car)))
       (set-cat-entry to-char att to-readtable)
       (set-cmt-entry to-char mac to-readtable)
-      (when from-dpair
-        (cond
-          (to-dpair
-           (let ((table (cdr to-dpair)))
-             (clrhash table)
-             (shallow-replace/eql-hash-table table (cdr from-dpair))))
-          (t
-           (let ((pair (cons to-char (make-hash-table))))
-             (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+      (cond ((and (not from-dpair) (not to-dpair)))
+            ((and (not from-dpair) to-dpair)
              (setf (dispatch-tables to-readtable)
-                   (push pair (dispatch-tables to-readtable)))))))))
+                   (remove to-dpair (dispatch-tables to-readtable))))
+            (to-dpair
+             (let ((table (cdr to-dpair)))
+               (clrhash table)
+               (shallow-replace/eql-hash-table table (cdr from-dpair))))
+            (t
+             (let ((pair (cons to-char (make-hash-table))))
+               (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+               (setf (dispatch-tables to-readtable)
+                     (push pair (dispatch-tables to-readtable))))))))
   t)
 
 (defun set-macro-character (char function &optional
@@ -270,7 +272,8 @@ standard Lisp readtable when NIL."
   "Causes CHAR to be a macro character which invokes FUNCTION when seen
    by the reader. The NON-TERMINATINGP flag can be used to make the macro
    character non-terminating, i.e. embeddable in a symbol name."
-  (let ((designated-readtable (or rt-designator *standard-readtable*)))
+  (let ((designated-readtable (or rt-designator *standard-readtable*))
+        (function (%coerce-callable-to-fun function)))
     (assert-not-standard-readtable designated-readtable 'set-macro-character)
     (set-cat-entry char (if non-terminatingp
                             +char-attr-constituent+