From cc676f35baa0a46df06d9917e087ca466d053027 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 14 May 2002 04:27:34 +0000 Subject: [PATCH] 0.7.3.16: (These changes might leave SET-SYNTAX-FROM-CHAR messed up. I'll try to fix that soon, or else add some tests to verify that it isn't too messed up.) ANSIfying FROB-MACRO-CHARACTER functions... ...made GET-MACRO-CHARACTER return NIL for non-macro characters ...made SET-MACRO-CHARACTER handle NIL values ...used %COERCE-CALLABLE-TO-FUN instead of COERCE ... 'FUNCTION Some of the "Unconstituentize some of them" operations in !COLD-INIT-STANDARD-READTABLE seem to've become no-ops, so delete them. It seems strange that ASCII RUBOUT should be treated as whitespace, so that e.g. "(+ 12)" EVALs to 3. So I deleted the customization of its entry in *STANDARD-READTABLE*, and now it's treated as just another character, which seems less surprising. --- BUGS | 14 ++++++ NEWS | 10 +++- src/code/reader.lisp | 131 +++++++++++++++++++++++++++++------------------- tests/reader.pure.lisp | 26 ++++++++-- version.lisp-expr | 2 +- 5 files changed, 125 insertions(+), 58 deletions(-) diff --git a/BUGS b/BUGS index 7c2f98b..0838256 100644 --- a/BUGS +++ b/BUGS @@ -1302,6 +1302,20 @@ WORKAROUND: ; caught 1 STYLE-WARNING condition But the code works as it should. Checked in 0.6.12.43 and later. +170: + (reported by Matthias Hoelzl on sbcl-devel 2002-05-13) + * (defmacro foo () ''x) + FOO + * (foo) + X + * (compile 'foo) + FOO + NIL + NIL + * (foo) + debugger invoked on condition of type UNDEFINED-FUNCTION: + The function FOO is undefined. + DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/NEWS b/NEWS index 08d6990..017a521 100644 --- a/NEWS +++ b/NEWS @@ -1108,11 +1108,17 @@ changes in sbcl-0.7.4 relative to sbcl-0.7.3: to Alexey Dejneka) * Dynamic loading of object files in OpenBSD is now supported. (thanks to Pierre Mai) + * GET-MACRO-CHARACTER and SET-MACRO-CHARACTER now represent + no-value-for-this-character as NIL (as specified by ANSI). + * HOST-NAMESTRING on physical pathnames now returns a string that is + valid as a host argument to MERGE-PATHNAMES and to MAKE-PATHNAME. * The fasl file format has changed again, because dynamic loading on OpenBSD (which has non-ELF object files) motivated some cleanups in the way that foreign symbols are transformed and passed around. - * HOST-NAMESTRING on physical pathnames now returns a string that is - valid as a host argument to MERGE-PATHNAMES and to MAKE-PATHNAME. + * minor incompatible change: The ASCII RUBOUT character, (CHAR-CODE 127), + is no longer treated as whitespace by the reader, but instead as + an ordinary character. Thus e.g. (READ-FROM-STRING "AB") returns + |AB|, instead of A as it used to. planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/code/reader.lisp b/src/code/reader.lisp index bc7c7b1..c97cae9 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -69,16 +69,28 @@ (char-code char)) newvalue)) -;;; FIXME: could be SB!XC:DEFMACRO inside EVAL-WHEN (COMPILE EVAL) -(defmacro get-cmt-entry (char rt) - `(the function - (elt (the simple-vector (character-macro-table ,rt)) - (char-code ,char)))) - -(defun set-cmt-entry (char newvalue &optional (rt *readtable*)) - (setf (elt (the simple-vector (character-macro-table rt)) - (char-code char)) - (coerce newvalue 'function))) +;;; the value actually stored in the character macro table. As per +;;; ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, this can +;;; be either a function or NIL. +(eval-when (:compile-toplevel :execute) + (sb!xc:defmacro get-raw-cmt-entry (char readtable) + `(svref (character-macro-table ,readtable) + (char-code ,char)))) + +;;; the value represented by whatever is stored in the character macro +;;; table. As per ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, +;;; a function value represents itself, and a NIL value represents the +;;; default behavior. +(defun get-coerced-cmt-entry (char readtable) + (the function + (or (get-raw-cmt-entry char readtable) + #'read-token))) + +(defun set-cmt-entry (char new-value-designator &optional (rt *readtable*)) + (setf (svref (character-macro-table rt) + (char-code char)) + (and new-value-designator + (%coerce-callable-to-fun new-value-designator)))) (defun undefined-macro-char (stream char) (unless *read-suppress* @@ -186,42 +198,51 @@ (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 really-from-readtable) + (get-raw-cmt-entry from-char really-from-readtable) to-readtable))) t) (defun set-macro-character (char function &optional - (non-terminatingp nil) (rt *readtable*)) + (non-terminatingp nil) + (readtable *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 - make the macro character non-terminating. The optional readtable - argument defaults to the current readtable. SET-MACRO-CHARACTER - returns 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*)) + "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 readtable *standard-readtable*))) + (set-cat-entry char + (if non-terminatingp + (get-secondary-attribute char) + +char-attr-terminating-macro+) + designated-readtable) + (set-cmt-entry char function designated-readtable) + t)) ; (ANSI-specified return value) + +(defun get-macro-character (char &optional (readtable *readtable*)) #!+sb-doc "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*))) - ;; Check macro syntax, return associated function if it's there. - ;; Returns a value for all constituents. - (cond ((constituentp char) - (values (get-cmt-entry char rt) t)) - ((terminating-macrop char) - (values (get-cmt-entry char rt) nil)) - (t nil)))) + character, or NIL if there is no such function. As a second value, return + T if CHAR is a macro character which is non-terminating, i.e. which can + be embedded in a symbol name." + (let* ((designated-readtable (or readtable *standard-readtable*)) + ;; the first return value: a FUNCTION if CHAR is a macro + ;; character, or NIL otherwise + (fun-value (get-raw-cmt-entry char designated-readtable))) + (values fun-value + ;; NON-TERMINATING-P return value: + (if fun-value + (or (constituentp char) + (not (terminating-macrop char))) + ;; ANSI's definition of GET-MACRO-CHARACTER says this + ;; value is NIL when CHAR is not a macro character. + ;; I.e. this value means not just "non-terminating + ;; character?" but "non-terminating macro character?". + nil)))) ;;;; definitions to support internal programming conventions -(defmacro eofp (char) `(eq ,char *eof-object*)) +(defmacro eofp (char) + `(eq ,char *eof-object*)) (defun flush-whitespace (stream) ;; This flushes whitespace chars, returning the last char it read (a @@ -249,27 +270,31 @@ (defun !cold-init-standard-readtable () (setq *standard-readtable* (make-readtable)) - ;; All characters default to "constituent" in MAKE-READTABLE. - ;; *** un-constituent-ize some of these *** + ;; All characters get boring defaults in MAKE-READTABLE. Now we + ;; override the boring defaults on characters which need more + ;; interesting behavior. (let ((*readtable* *standard-readtable*)) - (set-cat-entry (code-char tab-char-code) +char-attr-whitespace+) - (set-cat-entry #\linefeed +char-attr-whitespace+) - (set-cat-entry #\space +char-attr-whitespace+) - (set-cat-entry (code-char form-feed-char-code) +char-attr-whitespace+) - (set-cat-entry (code-char return-char-code) +char-attr-whitespace+) + + (flet ((whitespaceify (char) + (set-cat-entry char +char-attr-whitespace+))) + (whitespaceify (code-char tab-char-code)) + (whitespaceify #\linefeed) + (whitespaceify #\space) + (whitespaceify (code-char form-feed-char-code)) + (whitespaceify (code-char return-char-code))) + (set-cat-entry #\\ +char-attr-escape+) (set-cmt-entry #\\ #'read-token) - (set-cat-entry (code-char rubout-char-code) +char-attr-whitespace+) - (set-cmt-entry #\: #'read-token) - (set-cmt-entry #\| #'read-token) - ;; macro definitions + + ;; Easy macro-character definitions are in this source file. (set-macro-character #\" #'read-string) - ;; * # macro (set-macro-character #\' #'read-quote) (set-macro-character #\( #'read-list) (set-macro-character #\) #'read-right-paren) (set-macro-character #\; #'read-comment) - ;; * backquote + ;; (The hairier macro-character definitions, for #\# and #\`, are + ;; defined elsewhere, in their own source files.) + ;; all constituents (do ((ichar 0 (1+ ichar)) (char)) @@ -277,7 +302,7 @@ (setq char (code-char ichar)) (when (constituentp char *standard-readtable*) (set-cat-entry char (get-secondary-attribute char)) - (set-cmt-entry char #'read-token))))) + (set-cmt-entry char nil))))) ;;;; implementation of the read buffer @@ -387,7 +412,7 @@ (cond ((eofp char) (return eof-value)) ((whitespacep char)) (t - (let* ((macrofun (get-cmt-entry char *readtable*)) + (let* ((macrofun (get-coerced-cmt-entry char *readtable*)) (result (multiple-value-list (funcall macrofun stream char)))) ;; Repeat if macro returned nothing. @@ -401,7 +426,9 @@ ;;; past them. We assume CHAR is not whitespace. (defun read-maybe-nothing (stream char) (let ((retval (multiple-value-list - (funcall (get-cmt-entry char *readtable*) stream char)))) + (funcall (get-coerced-cmt-entry char *readtable*) + stream + char)))) (if retval (rplacd retval nil)))) (defun read (&optional (stream *standard-input*) diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 46f4db2..9a43074 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -16,14 +16,14 @@ (assert (equal (symbol-name '#:|fd\sA|) "fdsA")) ;;; Prior to sbcl-0.7.2.10, SBCL disobeyed the ANSI requirements on -;;; returning NIL for unset dispatch-macro-character functions (bug +;;; returning NIL for unset dispatch-macro-character functions. (bug ;;; 151, fixed by Alexey Dejenka sbcl-devel "bug 151" 2002-04-12) (assert (not (get-dispatch-macro-character #\# #\{))) (assert (not (get-dispatch-macro-character #\# #\0))) -;;; and we might as well test that we don't have any cross-compilation +;;; And we might as well test that we don't have any cross-compilation ;;; shebang residues left... (assert (not (get-dispatch-macro-character #\# #\!))) -;;; also test that all the illegal sharp macro characters are +;;; Also test that all the illegal sharp macro characters are ;;; recognized as being illegal. (loop for char in '(#\Backspace #\Tab #\Newline #\Linefeed #\Page #\Return #\Space #\) #\<) @@ -31,3 +31,23 @@ (assert (not (ignore-errors (get-dispatch-macro-character #\! #\0) t))) + +;;; In sbcl-0.7.3, GET-MACRO-CHARACTER and SET-MACRO-CHARACTER didn't +;;; use NIL to represent the no-macro-attached-to-this-character case +;;; as ANSI says they should. (This problem is parallel to the +;;; GET-DISPATCH-MACRO misbehavior fixed in sbcl-0.7.2.10, but +;;; was fixed a little later.) +(dolist (customizable-char + ;; According to ANSI "2.1.4 Character Syntax Types", these + ;; characters are reserved for the programmer. + '(#\? #\! #\[ #\] #\{ #\})) + ;; So they should have no macro-characterness. + (multiple-value-bind (macro-fun non-terminating-p) + (get-macro-character customizable-char) + (assert (null macro-fun)) + ;; Also, in a bit of ANSI weirdness, NON-TERMINATING-P can be + ;; true only when MACRO-FUN is true. (When the character + ;; is not a macro character, it can be embedded in a token, + ;; so it'd be more logical for NON-TERMINATING-P to be T in + ;; this case; but ANSI says it's NIL in this case. + (assert (null non-terminating-p)))) diff --git a/version.lisp-expr b/version.lisp-expr index fc9402d..24a0cb8 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.7.3.15" +"0.7.3.16" -- 1.7.10.4