From 333049ee307ddeb69d4b7eee3c2a381da494da31 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 3 Dec 2011 11:37:24 +0200 Subject: [PATCH] adjust compiler-macro expansion and lambda-list parsing * Don't convert errors during compiler-macro expansion into runtime PROGRAM-ERRORs: signal a compile-time warning, and simply decline to expand the compiler-macro. This lives in CAREFUL-EXPAND-MACRO. * Make compiler not expand compiler-macros if there are arguments in keyword positions that are not self-evaluating constant symbols. This lives in two places: (1) VERIFY-KEYWORDS signals a COMPILER-MACRO-KEYWORD-PROBLEM when it encounters either an unknown keyword or anything except a self-evaluating symbol in a keyword position when parsing compiler-macro keywords. (2) IR1-CONVERT-FUNCTOID handles this condition by unwinding from the compiler-macro expansion, printing a note about the problem, and returning the original form. Calling COMPILER-MACRO-FUNCTION directly behaves exactly as before, for both good and ill: good in the sense that it is compliant, ill in the sense that doing things that way may expand things the compiler would decline to expand: (define-compiler-macro foo (&key ((a ax) t)) (format nil "a=~S" ax)) The compiler would refuse to expand (foo a 42) unless (defconstant a 'a) had been done beforehand, but calling the COMPILER-MACRO-FUNCTION directly would expand it even without that -- as the spec unfortuntely requires. --- NEWS | 14 ++++-- package-data-list.lisp-expr | 1 + src/code/condition.lisp | 11 ++++- src/code/parse-defmacro.lisp | 38 ++++++++++++----- src/compiler/ir1report.lisp | 6 +-- src/compiler/ir1tran.lisp | 40 +++++++++++------ tests/compiler.impure.lisp | 97 ++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 175 insertions(+), 32 deletions(-) diff --git a/NEWS b/NEWS index aa74d32..43a87e6 100644 --- a/NEWS +++ b/NEWS @@ -6,10 +6,9 @@ changes relative to sbcl-1.0.57: updates of CAS-able places (similar to Clojure's swap!). * enhancement: run-program no longer decodes and re-encodes environment when :environment argument is not provided. (lp#985904) - * enhancement: On SPARC, a limitation on the number of code constants - emittable by the compiler has been lifted, allowing certain long functions - to compiled and assembled which had previously been unsupported; fixes - cl-bench on this ISA (lp#1008996). + * enhancement: errors during compiler-macro expansion no longer cause + runtime errors, only a compile-time warning, otherwise behaving as if + the compiler macro had declined to expand. * optimization: On x86-64, code alignment of block headers is done with multi-byte NOPs now instead of repetitions of the single-byte NOP. * optimization: MAP-INTO is substantially faster when the target sequence is @@ -20,6 +19,10 @@ changes relative to sbcl-1.0.57: function cannot escape. * optimization: SB-SEQUENCE:DOSEQUENCE is faster on vectors of unknown element type, and vectors that aren't SIMPLE-ARRAYs. + * bug fix: On SPARC, a limitation on the number of code constants emittable + by the compiler has been lifted, allowing certain long functions to + compiled and assembled which had previously been unsupported; fixes + cl-bench on this ISA (lp#1008996). * bug fix: potential for infinite recursion during compilation of CLOS slot typechecks when dependency graph had loops. (lp#1001799) * bug fix: error forms reported with some program-errors were not escaped @@ -34,6 +37,9 @@ changes relative to sbcl-1.0.57: * bug fix: restore build on solaris/sparc. (lp#1008506) * bug fix: an issue with LDB in the PowerPC backend has been resolved; this fixes an issue found with cl-postgres (thanks to Tomas Hlavaty). + * bug fix: compiler-macro lambda-lists specifying non-keyword symbols + as keyword arguments no longer accidentally match unevaluated symbols + against them. changes in sbcl-1.0.57 relative to sbcl-1.0.56: * RANDOM enhancements and bug fixes: diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 790a51a..770f381 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -958,6 +958,7 @@ possibly temporariliy, because it might be used internally." "BAD-TYPE" "CLOSED-STREAM-ERROR" "COMPILED-PROGRAM-ERROR" + "COMPILER-MACRO-KEYWORD-PROBLEM" "ENCAPSULATED-CONDITION" "INTERPRETED-PROGRAM-ERROR" "INVALID-ARRAY-ERROR" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 08f2f99..ab6e942 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1738,5 +1738,14 @@ not exists.") condition, stepping into the current form. Signals a CONTROL-ERROR is the restart does not exist.")) -(/show0 "condition.lisp end of file") +;;; Compiler macro magic + +(define-condition compiler-macro-keyword-problem () + ((argument :initarg :argument :reader compiler-macro-keyword-argument)) + (:report (lambda (condition stream) + (format stream "~@" + (compiler-macro-keyword-argument condition))))) +(/show0 "condition.lisp end of file") diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp index 0ddf097..f745a84 100644 --- a/src/code/parse-defmacro.lisp +++ b/src/code/parse-defmacro.lisp @@ -328,7 +328,8 @@ (push `(multiple-value-bind (,problem ,info) (verify-keywords ,rest-name ',keys - ',allow-other-keys-p) + ',allow-other-keys-p + ,(eq 'define-compiler-macro context)) (when ,problem (,error-fun 'defmacro-lambda-list-broken-key-list-error @@ -407,7 +408,7 @@ ;;; Determine whether KEY-LIST is a valid list of keyword/value pairs. ;;; Do not signal the error directly, 'cause we don't know how it ;;; should be signaled. -(defun verify-keywords (key-list valid-keys allow-other-keys) +(defun verify-keywords (key-list valid-keys allow-other-keys &optional compiler-macro) (do ((already-processed nil) (unknown-keyword nil) (remaining key-list (cddr remaining))) @@ -417,15 +418,30 @@ (not (lookup-keyword :allow-other-keys key-list))) (values :unknown-keyword (list unknown-keyword valid-keys)) (values nil nil))) - (cond ((not (and (consp remaining) (listp (cdr remaining)))) - (return (values :dotted-list key-list))) - ((null (cdr remaining)) - (return (values :odd-length key-list))) - ((or (eq (car remaining) :allow-other-keys) - (member (car remaining) valid-keys)) - (push (car remaining) already-processed)) - (t - (setq unknown-keyword (car remaining)))))) + (let ((key (when (consp remaining) + (car remaining)))) + (cond ((not (and (consp remaining) (listp (cdr remaining)))) + (return (values :dotted-list key-list))) + ((null (cdr remaining)) + (return (values :odd-length key-list)))) + ;; Compiler-macro lambda lists are macro lambda lists -- meaning that + ;; &key ((a a) t) should match a literal A, not a form evaluating to A + ;; as in an ordinary lambda list. + ;; + ;; That, however, breaks the evaluation model unless A is also a + ;; constant evaluating to itself. So, signal a condition telling the + ;; compiler to punt on the expansion. + (when (and compiler-macro + (not (or (keywordp key) + (and (symbolp key) + (constantp key) + (eq key (symbol-value key)))))) + (signal 'compiler-macro-keyword-problem :argument key)) + (cond ((or (eq key :allow-other-keys) + (member key valid-keys)) + (push key already-processed)) + (t + (setq unknown-keyword key)))))) (defun lookup-keyword (keyword key-list) (do ((remaining key-list (cddr remaining))) diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp index d5864d6..6a6bb12 100644 --- a/src/compiler/ir1report.lisp +++ b/src/compiler/ir1report.lisp @@ -281,9 +281,9 @@ ;;; ;;; We suppress printing of messages identical to the previous, but ;;; record the number of times that the message is repeated. -(defmacro print-compiler-message (stream format-string format-args) - `(with-compiler-io-syntax - (%print-compiler-message ,stream ,format-string ,format-args))) +(defun print-compiler-message (stream format-string format-args) + (with-compiler-io-syntax + (%print-compiler-message stream format-string format-args))) (defun %print-compiler-message (stream format-string format-args) (declare (type simple-string format-string)) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 20f7a94..5a448fd 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -732,7 +732,11 @@ ;; CLHS 3.2.2.1.3 specifies that NOTINLINE ;; suppresses compiler-macros. (not (fun-lexically-notinline-p cmacro-fun-name))) - (let ((res (careful-expand-macro cmacro-fun form t))) + (let ((res (handler-case + (careful-expand-macro cmacro-fun form t) + (compiler-macro-keyword-problem (c) + (print-compiler-message *error-output* "note: ~A" (list c)) + form)))) (cond ((eq res form) (ir1-convert-common-functoid start next result form op)) (t @@ -797,15 +801,16 @@ (let (;; We rely on the printer to abbreviate FORM. (*print-length* 3) (*print-level* 3)) - (format - nil - #-sb-xc-host "~@<~;during ~A of ~S. Use ~S to intercept:~%~:@>" - ;; longer message to avoid ambiguity "Was it the xc host - ;; or the cross-compiler which encountered the problem?" - #+sb-xc-host "~@<~;during cross-compiler ~A of ~S. Use ~S to intercept:~%~:@>" - (if cmacro "compiler-macroexpansion" "macroexpansion") - form - '*break-on-signals*)))) + (format nil + "~@<~A of ~S. Use ~S to intercept.~%~:@>" + (cond (cmacro + #-sb-xc-host "Error during compiler-macroexpansion" + #+sb-xc-host "Error during XC compiler-macroexpansion") + (t + #-sb-xc-host "during macroexpansion" + #+sb-xc-host "during XC macroexpansion")) + form + '*break-on-signals*)))) (handler-bind (;; KLUDGE: CMU CL in its wisdom (version 2.4.6 for Debian ;; Linux, anyway) raises a CL:WARNING condition (not a ;; CL:STYLE-WARNING) for undefined symbols when converting @@ -836,9 +841,18 @@ (wherestring) c) (muffle-warning-or-die))) - (error (lambda (c) - (compiler-error "~@<~A~@:_ ~A~:>" - (wherestring) c)))) + (error + (lambda (c) + (cond + (cmacro + ;; The spec is silent on what we should do. Signaling + ;; a full warning but declining to expand seems like + ;; a conservative and sane thing to do. + (compiler-warn "~@<~A~@:_ ~A~:>" (wherestring) c) + (return-from careful-expand-macro form)) + (t + (compiler-error "~@<~A~@:_ ~A~:>" + (wherestring) c)))))) (funcall sb!xc:*macroexpand-hook* fun form *lexenv*)))) ;;;; conversion utilities diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 263aef1..43e3bee 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -15,6 +15,8 @@ ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. +(in-package :cl-user) + (when (eq sb-ext:*evaluator-mode* :interpret) (sb-ext:exit :code 104)) @@ -1312,6 +1314,101 @@ (assert (eq :failed (test "(defun no-pkg::foo ())"))) (assert (eq :failed (test "(cl:no-such-sym)"))) (assert (eq :failed (test "..."))))) + +(defun cmacro-signals-error () :fun) +(define-compiler-macro cmacro-signals-error () (error "oops")) + +(with-test (:name :cmacro-signals-error) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-signals-error))) + (assert (and fun warn fail)) + (assert (eq :fun (funcall fun))))) + +(defun cmacro-with-simple-key (&key a) + (format nil "fun=~A" a)) +(define-compiler-macro cmacro-with-simple-key (&whole form &key a) + (if (constantp a) + (format nil "cmacro=~A" (eval a)) + form)) + +(with-test (:name (:cmacro-with-simple-key :no-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-simple-key))) + (assert (and (not warn) (not fail))) + (assert (string= "cmacro=NIL" (funcall fun))))) + +(with-test (:name (:cmacro-with-simple-key :constant-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-simple-key :a 42))) + (assert (and (not warn) (not fail))) + (assert (string= "cmacro=42" (funcall fun))))) + +(with-test (:name (:cmacro-with-simple-key :variable-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda (x) (cmacro-with-simple-key x 42))) + (assert (and (not warn) (not fail))) + (assert (string= "fun=42" (funcall fun :a))))) + +(defun cmacro-with-nasty-key (&key ((nasty-key var))) + (format nil "fun=~A" var)) +(define-compiler-macro cmacro-with-nasty-key (&whole form &key ((nasty-key var))) + (if (constantp var) + (format nil "cmacro=~A" (eval var)) + form)) + +(with-test (:name (:cmacro-with-nasty-key :no-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-nasty-key))) + (assert (and (not warn) (not fail))) + (assert (string= "cmacro=NIL" (funcall fun))))) + +(with-test (:name (:cmacro-with-nasty-key :constant-key)) + ;; This bogosity is thanks to cmacro lambda lists being /macro/ lambda + ;; lists. + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-nasty-key 'nasty-key 42))) + (assert (and (not warn) (not fail))) + (assert (string= "fun=42" (funcall fun))))) + +(with-test (:name (:cmacro-with-nasty-key :variable-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda (nasty-key) (cmacro-with-nasty-key nasty-key 42))) + (assert (and (not warn) (not fail))) + (assert (string= "fun=42" (funcall fun 'nasty-key))))) + +(defconstant tricky-key 'tricky-key) +(defun cmacro-with-tricky-key (&key ((tricky-key var))) + (format nil "fun=~A" var)) +(define-compiler-macro cmacro-with-tricky-key (&whole form &key ((tricky-key var))) + (if (constantp var) + (format nil "cmacro=~A" (eval var)) + form)) + +(with-test (:name (:cmacro-with-tricky-key :no-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-tricky-key))) + (assert (and (not warn) (not fail))) + (assert (string= "cmacro=NIL" (funcall fun))))) + +(with-test (:name (:cmacro-with-tricky-key :constant-quoted-key)) + ;; This bogosity is thanks to cmacro lambda lists being /macro/ lambda + ;; lists. + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-tricky-key 'tricky-key 42))) + (assert (and (not warn) (not fail))) + (assert (string= "fun=42" (funcall fun))))) + +(with-test (:name (:cmacro-with-tricky-key :constant-unquoted-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () (cmacro-with-tricky-key tricky-key 42))) + (assert (and (not warn) (not fail))) + (assert (string= "cmacro=42" (funcall fun))))) + +(with-test (:name (:cmacro-with-tricky-key :variable-key)) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda (x) (cmacro-with-tricky-key x 42))) + (assert (and (not warn) (not fail))) + (assert (string= "fun=42" (funcall fun 'tricky-key))))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself -- 1.7.10.4