From de1859fb0815446420c6e0d58adb266012134acc Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 11 Aug 2006 13:37:18 +0000 Subject: [PATCH] 0.9.15.27: compiler-macro expansion for FUNCALL forms & bugfixes * Refactor the compiler to first consider special forms and compiler-macro expansions before other options. (Necessary for the rest.) * FUNCALL forms now get compiler-macro expansion when applicable. * COMPILER-MACRO-FUNCTION takes shadowing by local functions into account. * Local INLINE declarations no longer inhibit compiler-macro expansion. * Tests. --- NEWS | 6 ++ src/compiler/info-functions.lisp | 36 ++++++---- src/compiler/ir1-translators.lisp | 2 + src/compiler/ir1tran.lisp | 139 ++++++++++++++++++++----------------- tests/compiler.impure.lisp | 41 ++++++++++- version.lisp-expr | 2 +- 6 files changed, 147 insertions(+), 79 deletions(-) diff --git a/NEWS b/NEWS index 6ff459b..2eeaff2 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,8 @@ changes in sbcl-0.9.16 relative to sbcl-0.9.15: improved. (reported by Any Fingerhut) * enhancement: SB-INTROSPECT is now able to find definitions of profiled functions. (thanks to Troels Henriksen) + * enhancement: compiler-macro expansion applies now to FUNCALL forms + as well. * fixed bug #337: use of MAKE-METHOD in method combination now works even in the presence of user-defined method classes. (reported by Bruno Haible and Pascal Costanza) @@ -31,6 +33,10 @@ changes in sbcl-0.9.16 relative to sbcl-0.9.15: of input-file instead of "fasl". (reported by Robert Dodier) * bug fix: compiler-macro lambda-list parsing of FUNCALL forms. (reported by James Y Knight). + * bug fix: compiler-macros-function did not consider the environment + argument for shadowing by local functions. + * bug fix: compiler-macros expansion was inhibited by local INLINE + declarations. changes in sbcl-0.9.15 relative to sbcl-0.9.14: * added support for the ucs-2 external format. (contributed by Ivan diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index 2691ab2..ebbfcac 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -124,10 +124,10 @@ (defun sb!xc:macro-function (symbol &optional env) #!+sb-doc "If SYMBOL names a macro in ENV, returns the expansion function, - else returns NIL. If ENV is unspecified or NIL, use the global - environment only." +else returns NIL. If ENV is unspecified or NIL, use the global environment +only." (declare (symbol symbol)) - (let* ((fenv (when env (sb!c::lexenv-funs env))) + (let* ((fenv (when env (lexenv-funs env))) (local-def (cdr (assoc symbol fenv)))) (cond (local-def (if (and (consp local-def) (eq (car local-def) 'macro)) @@ -165,20 +165,30 @@ (error 'undefined-function :name symbol))) function) +(defun fun-locally-defined-p (name env) + (and env + (let ((fun (cdr (assoc name (lexenv-funs env) :test #'equal)))) + (and fun (not (global-var-p fun)))))) + (defun sb!xc:compiler-macro-function (name &optional env) #!+sb-doc "If NAME names a compiler-macro in ENV, return the expansion function, else - return NIL. Can be set with SETF when ENV is NIL." - (declare (ignore env)) +return NIL. Can be set with SETF when ENV is NIL." (legal-fun-name-or-type-error name) - ;; Note: CMU CL used to return NIL here when a NOTINLINE declaration - ;; was in force. That's fairly logical, given the specified effect - ;; of NOTINLINE declarations on compiler-macro expansion. However, - ;; (1) it doesn't seem to be consistent with the ANSI spec for - ;; COMPILER-MACRO-FUNCTION, and (2) it would give surprising - ;; behavior for (SETF (COMPILER-MACRO-FUNCTION FOO) ...) in the - ;; presence of a (PROCLAIM '(NOTINLINE FOO)). So we don't do it. - (values (info :function :compiler-macro-function name))) + ;; CLHS 3.2.2.1: Creating a lexical binding for the function name + ;; not only creates a new local function or macro definition, but + ;; also shadows[2] the compiler macro. + (unless (fun-locally-defined-p name env) + ;; Note: CMU CL used to return NIL here when a NOTINLINE + ;; declaration was in force. That's fairly logical, given the + ;; specified effect of NOTINLINE declarations on compiler-macro + ;; expansion. However, (1) it doesn't seem to be consistent with + ;; the ANSI spec for COMPILER-MACRO-FUNCTION, and (2) it would + ;; give surprising behavior for (SETF (COMPILER-MACRO-FUNCTION + ;; FOO) ...) in the presence of a (PROCLAIM '(NOTINLINE FOO)). So + ;; we don't do it. + (values (info :function :compiler-macro-function name)))) + (defun (setf sb!xc:compiler-macro-function) (function name &optional env) (declare (type (or symbol list) name) (type (or function null) function)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index aa92588..c8b2473 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -947,6 +947,8 @@ ;;; function and smashes it to a :CLEANUP function, as well as ;;; referencing it. (def-ir1-translator %cleanup-fun ((name) start next result) + ;; FIXME: Should this not be :TEST #'EQUAL? What happens to + ;; (SETF FOO) here? (let ((fun (lexenv-find name funs))) (aver (lambda-p fun)) (setf (functional-kind fun) :cleanup) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index c6cf4d0..783ba7b 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -497,41 +497,7 @@ (t (reference-constant start next result form)))) (t - (let ((opname (car form))) - (cond ((or (symbolp opname) (leaf-p opname)) - (let ((lexical-def (if (leaf-p opname) - opname - (lexenv-find opname funs)))) - (typecase lexical-def - (null - (ir1-convert-global-functoid start next result - form)) - (functional - (ir1-convert-local-combination start next result - form - lexical-def)) - (global-var - (ir1-convert-srctran start next result - lexical-def form)) - (t - (aver (and (consp lexical-def) - (eq (car lexical-def) 'macro))) - (ir1-convert start next result - (careful-expand-macro - (cdr lexical-def) - form)))))) - ((or (atom opname) (not (eq (car opname) 'lambda))) - (compiler-error "illegal function call")) - (t - ;; implicitly (LAMBDA ..) because the LAMBDA - ;; expression is the CAR of an executed form - (ir1-convert-combination start next result - form - (ir1-convert-lambda - opname - :debug-name (debug-name - 'lambda-car - opname)))))))))) + (ir1-convert-functoid start next result form))))) (values)) ;; Generate a reference to a manifest constant, creating a new leaf @@ -649,43 +615,88 @@ (ir1-convert start next result `(%heap-alien ',var))))) (values)) -;;; Convert anything that looks like a special form, global function -;;; or compiler-macro call. -(defun ir1-convert-global-functoid (start next result form) - (declare (type ctran start next) (type (or lvar null) result) (list form)) - (let* ((fun-name (first form)) - (translator (info :function :ir1-convert fun-name)) - (cmacro-fun (sb!xc:compiler-macro-function fun-name *lexenv*))) +;;; Find a compiler-macro for a form, taking FUNCALL into account. +(defun find-compiler-macro (opname form) + (if (eq opname 'funcall) + (let ((fun-form (cadr form))) + (cond ((and (consp fun-form) (eq 'function (car fun-form))) + (let ((real-fun (cadr fun-form))) + (if (legal-fun-name-p real-fun) + (values (sb!xc:compiler-macro-function real-fun *lexenv*) + real-fun) + (values nil nil)))) + ((sb!xc:constantp fun-form *lexenv*) + (let ((fun (constant-form-value fun-form *lexenv*))) + (if (legal-fun-name-p fun) + ;; CLHS tells us that local functions must shadow + ;; compiler-macro-functions, but since the call is + ;; through a name, we are obviously interested + ;; in the global function. + (values (sb!xc:compiler-macro-function fun nil) fun) + (values nil nil)))) + (t + (values nil nil)))) + (if (legal-fun-name-p opname) + (values (sb!xc:compiler-macro-function opname *lexenv*) opname) + (values nil nil)))) + +;;; Picks of special forms and compiler-macro expansions, and hands +;;; the rest to IR1-CONVERT-COMMON-FUNCTOID +(defun ir1-convert-functoid (start next result form) + (let* ((op (car form)) + (translator (and (symbolp op) (info :function :ir1-convert op)))) (cond (translator - (when cmacro-fun + (when (sb!xc:compiler-macro-function op *lexenv*) (compiler-warn "ignoring compiler macro for special form")) (funcall translator start next result form)) - ((and cmacro-fun - ;; gotcha: If you look up the DEFINE-COMPILER-MACRO - ;; macro in the ANSI spec, you might think that - ;; suppressing compiler-macro expansion when NOTINLINE - ;; is some pre-ANSI hack. However, if you look up the - ;; NOTINLINE declaration, you'll find that ANSI - ;; requires this behavior after all. - (not (eq (info :function :inlinep fun-name) :notinline))) - (let ((res (careful-expand-macro cmacro-fun form))) - (if (eq res form) - (ir1-convert-global-functoid-no-cmacro - start next result form fun-name) - (ir1-convert start next result res)))) (t - (ir1-convert-global-functoid-no-cmacro start next result - form fun-name))))) + (multiple-value-bind (cmacro-fun cmacro-fun-name) + (find-compiler-macro op form) + (if (and cmacro-fun + ;; 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))) + (if (eq res form) + (ir1-convert-common-functoid start next result form + op) + (ir1-convert start next result res))) + (ir1-convert-common-functoid start next result form op))))))) + +;;; Handles the "common" cases: any other forms except special forms +;;; and compiler-macros. +(defun ir1-convert-common-functoid (start next result form op) + (cond ((or (symbolp op) (leaf-p op)) + (let ((lexical-def (if (leaf-p op) op (lexenv-find op funs)))) + (typecase lexical-def + (null + (ir1-convert-global-functoid start next result form op)) + (functional + (ir1-convert-local-combination start next result form + lexical-def)) + (global-var + (ir1-convert-srctran start next result lexical-def form)) + (t + (aver (and (consp lexical-def) (eq (car lexical-def) 'macro))) + (ir1-convert start next result + (careful-expand-macro (cdr lexical-def) form)))))) + ((or (atom op) (not (eq (car op) 'lambda))) + (compiler-error "illegal function call")) + (t + ;; implicitly (LAMBDA ..) because the LAMBDA expression is + ;; the CAR of an executed form. + (ir1-convert-combination + start next result form + (ir1-convert-lambda op + :debug-name (debug-name 'inline-lambda op)))))) -;;; Handle the case of where the call was not a compiler macro, or was -;;; a compiler macro and passed. -(defun ir1-convert-global-functoid-no-cmacro (start next result form fun) +;;; Convert anything that looks like a global function call. +(defun ir1-convert-global-functoid (start next result form fun) (declare (type ctran start next) (type (or lvar null) result) (list form)) ;; FIXME: Couldn't all the INFO calls here be converted into - ;; standard CL functions, like MACRO-FUNCTION or something? - ;; And what happens with lexically-defined (MACROLET) macros - ;; here, anyway? + ;; standard CL functions, like MACRO-FUNCTION or something? And what + ;; happens with lexically-defined (MACROLET) macros here, anyway? (ecase (info :function :kind fun) (:macro (ir1-convert start next result diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index cb75fe1..0f6da5e 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1262,7 +1262,12 @@ (type-error (c) (assert (eq (type-error-expected-type c) 'integer))) (:no-error (&rest vals) (error "no error")))) -;;; FUNCALL forms in compiler macros +;;; Basic compiler-macro expansion +(define-compiler-macro test-cmacro-0 () ''expanded) + +(assert (eq 'expanded (funcall (lambda () (test-cmacro-0))))) + +;;; FUNCALL forms in compiler macros, lambda-list parsing (define-compiler-macro test-cmacro-1 (&whole whole a &optional b &rest c &key d) (list whole a b c d)) @@ -1279,4 +1284,38 @@ (test (funcall 'test-cmacro-1 1 2 :d 3) 1 2 '(:d 3) 3) (test (test-cmacro-1 11 12 :d 13) 11 12 '(:d 13) 13)) +;;; FUNCALL forms in compiler macros, expansions +(define-compiler-macro test-cmacro-2 () ''ok) + +(assert (eq 'ok (funcall (lambda () (funcall 'test-cmacro-2))))) +(assert (eq 'ok (funcall (lambda () (funcall #'test-cmacro-2))))) + +;;; Shadowing of compiler-macros by local functions +(define-compiler-macro test-cmacro-3 () ''global) + +(defmacro find-cmacro-3 (&environment env) + (compiler-macro-function 'test-cmacro-3 env)) + +(assert (funcall (lambda () (find-cmacro-3)))) +(assert (not (funcall (lambda () (flet ((test-cmacro-3 ())) + (find-cmacro-3)))))) +(assert (eq 'local (funcall (lambda () (flet ((test-cmacro-3 () 'local)) + (test-cmacro-3)))))) +(assert (eq 'local (funcall (lambda () (flet ((test-cmacro-3 () 'local)) + (funcall #'test-cmacro-3)))))) +(assert (eq 'global (funcall (lambda () (flet ((test-cmacro-3 () 'local)) + (funcall 'test-cmacro-3)))))) + +;;; Local NOTINLINE & INLINE +(defun test-cmacro-4 () 'fun) +(define-compiler-macro test-cmacro-4 () ''macro) + +(assert (eq 'fun (funcall (lambda () + (declare (notinline test-cmacro-4)) + (test-cmacro-4))))) + +(assert (eq 'macro (funcall (lambda () + (declare (inline test-cmacro-4)) + (test-cmacro-4))))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index d771f49..b0b10d9 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.15.26" +"0.9.15.27" -- 1.7.10.4