From 45e102d04c2fd1be31ccb9f63d123ea86afb1858 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 27 Dec 2001 18:22:41 +0000 Subject: [PATCH] 0.pre7.101: merged APD patches for readtable functions (2 patches, both on sbcl-devel 2001-12-24) --- TODO | 6 ++---- src/code/reader.lisp | 41 ++++++++++++++++++++++------------------- version.lisp-expr | 2 +- 3 files changed, 25 insertions(+), 24 deletions(-) diff --git a/TODO b/TODO index 506b353..6225be1 100644 --- a/TODO +++ b/TODO @@ -15,11 +15,9 @@ for 0.7.0: ** four-space indentation in C * pending patches and bug reports that go in (or else get handled somehow, rejected/logged/whatever) before 0.7.0: - ** AD "BUG in nested backquotes processing" - sbcl-devel 2001-12-21 - ** NJF bug report "bug in COPY-READTABLE" and AD patch, + ** NJF bug report "bug in COPY-READTABLE" and APD patch, both sbcl-devel 2001-12-24 - ** AD patch for other readtable functions, sbcl-devel 2001-12-24 + ** APD patch for other readtable functions, sbcl-devel 2001-12-24 ======================================================================= for early 0.7.x: diff --git a/src/code/reader.lisp b/src/code/reader.lisp index d630514..953ab92 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -154,19 +154,20 @@ ;;;; readtable operations (defun copy-readtable (&optional (from-readtable *readtable*) - (to-readtable (make-readtable))) - (let ((really-from-readtable (or from-readtable *standard-readtable*))) - (replace (character-attribute-table to-readtable) + to-readtable) + (let ((really-from-readtable (or from-readtable *standard-readtable*)) + (really-to-readtable (or to-readtable (make-readtable)))) + (replace (character-attribute-table really-to-readtable) (character-attribute-table really-from-readtable)) - (replace (character-macro-table to-readtable) + (replace (character-macro-table really-to-readtable) (character-macro-table really-from-readtable)) - (setf (dispatch-tables to-readtable) + (setf (dispatch-tables really-to-readtable) (mapcar #'(lambda (pair) (cons (car pair) (copy-seq (cdr pair)))) (dispatch-tables really-from-readtable))) - (setf (readtable-case to-readtable) - (readtable-case from-readtable)) - to-readtable)) + (setf (readtable-case really-to-readtable) + (readtable-case really-from-readtable)) + really-to-readtable)) (defun set-syntax-from-char (to-char from-char &optional (to-readtable *readtable*) @@ -192,20 +193,21 @@ (defun set-macro-character (char function &optional (non-terminatingp nil) (rt *readtable*)) #!+sb-doc - "Causes char to be a macro character which invokes function when - seen by the reader. The non-terminatingp flag can be used to + "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. The optional readtable - argument defaults to the current readtable. Set-macro-character + argument defaults to the current readtable. SET-MACRO-CHARACTER returns T." - (if non-terminatingp - (set-cat-entry char (get-secondary-attribute char) rt) - (set-cat-entry char +char-attr-terminating-macro+ rt)) - (set-cmt-entry char function rt) - T) + (let ((rt (or rt *standard-readtable*))) + (if non-terminatingp + (set-cat-entry char (get-secondary-attribute char) rt) + (set-cat-entry char +char-attr-terminating-macro+ rt)) + (set-cmt-entry char function rt) + T)) (defun get-macro-character (char &optional (rt *readtable*)) #!+sb-doc - "Return the function associated with the specified char which is a macro + "Return the function associated with the specified CHAR which is a macro character. The optional readtable argument defaults to the current readtable." (let ((rt (or rt *standard-readtable*))) @@ -1291,6 +1293,7 @@ (when (digit-char-p sub-char) (error "SUB-CHAR must not be a decimal digit: ~S" sub-char)) (let* ((sub-char (char-upcase sub-char)) + (rt (or rt *standard-readtable*)) (dpair (find disp-char (dispatch-tables rt) :test #'char= :key #'car))) (if dpair @@ -1302,8 +1305,8 @@ (defun get-dispatch-macro-character (disp-char sub-char &optional (rt *readtable*)) #!+sb-doc - "Return the macro character function for sub-char under disp-char - or nil if there is no associated function." + "Return the macro character function for SUB-CHAR under DISP-CHAR + or NIL if there is no associated function." (unless (digit-char-p sub-char) (let* ((sub-char (char-upcase sub-char)) (rt (or rt *standard-readtable*)) diff --git a/version.lisp-expr b/version.lisp-expr index f6b1197..b431767 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.100" +"0.pre7.101" -- 1.7.10.4