X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=56b8ac1a45c09878eba3819d7e931514bfd0e3f6;hb=6caf3ed5713773cb423f46bf40a29f2438c97c78;hp=7cdd79baeeff78fde390dfa8c17c325c28a67b78;hpb=5185986c75b5c2cbc2114e867e1a5cd64c49de06;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 7cdd79b..56b8ac1 100644
--- 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+
@@ -1577,7 +1580,7 @@ standard Lisp readtable when NIL."
 
 (define-compiler-macro read-from-string (&whole form string &rest args)
   ;; Check this at compile-time, and rewrite it so we're silent at runtime.
-  (destructuring-bind (&optional eof-error-p eof-value &rest keys)
+  (destructuring-bind (&optional (eof-error-p t) eof-value &rest keys)
       args
     (cond ((maybe-note-read-from-string-signature-issue eof-error-p)
            `(read-from-string ,string t ,eof-value ,@keys))
@@ -1598,7 +1601,7 @@ standard Lisp readtable when NIL."
                              (:preserve-whitespace preserve-whitespace)
                              (otherwise
                               (return-from read-from-string form)))))
-                 (when (assoc key seen)
+                 (when (member key seen)
                    (setf var (gensym "IGNORE"))
                    (push var ignore))
                  (push key seen)