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
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
* 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:
"BAD-TYPE"
"CLOSED-STREAM-ERROR"
"COMPILED-PROGRAM-ERROR"
+ "COMPILER-MACRO-KEYWORD-PROBLEM"
"ENCAPSULATED-CONDITION"
"INTERPRETED-PROGRAM-ERROR"
"INVALID-ARRAY-ERROR"
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 "~@<Argument ~S in keyword position is not ~
+ a self-evaluating symbol, preventing compiler-macro ~
+ expansion.~@:>"
+ (compiler-macro-keyword-argument condition)))))
+(/show0 "condition.lisp end of file")
(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
;;; 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)))
(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)))
;;;
;;; 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))
;; 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
(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
(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*))))
\f
;;;; conversion utilities
;;;; 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))
(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)))))
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
projects / sbcl.git / commitdiff