diff --git a/code/reader.lisp b/code/reader.lisp index 7d6279cbbdccfd1f84c0c61f28e8571938ed6c70..ab620f8621fc9dd51c1315b20ecbff1c19c10a59 100644 --- a/code/reader.lisp +++ b/code/reader.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.57 2005/10/21 13:11:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.58 2006/02/17 21:27:06 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -318,13 +318,33 @@ ;;from char is a constituent you don't copy non-movable secondary ;;attributes (constituent types), and that said attributes magically ;;appear if you transform a non-constituent to a constituent. - (let ((att (get-cat-entry from-char from-readtable))) + (let ((att (get-cat-entry from-char from-readtable)) + (mac (get-cmt-entry from-char from-readtable)) + (from-dpair (find from-char (dispatch-tables from-readtable) + :test #'char= :key #'car)) + (to-dpair (find to-char (dispatch-tables to-readtable) + :test #'char= :key #'car))) (if (constituentp from-char from-readtable) (setq att (get-secondary-attribute to-char))) (set-cat-entry to-char att to-readtable) (set-cmt-entry to-char - (get-cmt-entry from-char from-readtable) - to-readtable))) + mac + to-readtable) + ;; Copy the reader macro functions too if from-char is a + ;; dispatching macro character. + (when from-dpair + (cond (to-dpair + ;; The to-readtable already has a dispatching table for + ;; this character. Replace it with a copy of the + ;; dispatching table from from-readtable. + (setf (cdr to-dpair) (copy-seq (cdr from-dpair)))) + (t + ;; The to-readtable doesn't have such an entry. Add a + ;; copy of dispatch table from from-readtable to the + ;; dispatch table of the to-readtable. + (let ((pair (cons to-char (copy-seq (cdr from-dpair))))) + (setf (dispatch-tables to-readtable) + (push pair (dispatch-tables to-readtable))))))))) t) (defun set-macro-character (char function &optional