From ec735ab75335c1744b39190314142a7e6f1ecdb3 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 27 Jan 2003 21:41:25 +0000 Subject: [PATCH] 0.7.12.7: Fix bug 228, by allowing pseudoLAMBDA-expressions to be compiled by FUNCTION and COMPILE: ... define IR1-CONVERT-LAMBDALIKE to massage the pseudolambda into a lambda; ... define SB-INT:NAMED-LAMBDA and SB-KERNEL:LAMBDA-WITH-LEXENV macros analogous to CL:LAMBDA; ... various bits of commentary. This change also has the effect of quieting the compiler when compiling defmethod forms with arguments naming classes and a CALL-NEXT-METHOD in the body. --- BUGS | 9 ------- NEWS | 3 +++ src/code/defboot.lisp | 10 +++++++ src/code/target-misc.lisp | 3 +++ src/compiler/ir1-translators.lisp | 52 ++++--------------------------------- src/compiler/ir1tran.lisp | 37 ++++++++++++++++++++++++-- src/compiler/main.lisp | 2 +- src/compiler/node.lisp | 6 +++++ tests/compiler.impure.lisp | 11 ++++++++ version.lisp-expr | 2 +- 10 files changed, 75 insertions(+), 60 deletions(-) diff --git a/BUGS b/BUGS index 4dd6c3a..a8ec1da 100644 --- a/BUGS +++ b/BUGS @@ -1166,15 +1166,6 @@ WORKAROUND: would be to put the check between evaluation of arguments, but it could be tricky to check result types of PROG1, IF etc. -228: "function-lambda-expression problems" - in sbcl-0.7.9.6x, from the REPL: - * (progn (declaim (inline foo)) (defun foo (x) x)) - FOO - * (function-lambda-expression #'foo) - (SB-C:LAMBDA-WITH-LEXENV NIL NIL NIL (X) (BLOCK FOO X)), NIL, FOO - but this first return value is not suitable for input to FUNCTION or - COMPILE, as required by ANSI. - 229: (subtypep 'function '(function)) => nil, t. diff --git a/NEWS b/NEWS index 2bbba60..406df41 100644 --- a/NEWS +++ b/NEWS @@ -1508,6 +1508,9 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12: * fixed bug 157: TYPEP, SUBTYPEP, UPGRADED-ARRAY-ELEMENT-TYPE and UPGRADED-COMPLEX-PART-TYPE now take (ignored, in all situations) optional environment arguments, as required by ANSI. + * fixed bug 228: primary return values from + FUNCTION-LAMBDA-EXPRESSION are either NIL or suitable for input to + COMPILE or FUNCTION. * fixed bugs in other functions taking environment objects, allowing calls with an explicit NIL environment argument to be compiled without error. diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 6e60eaf..6a38a96 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -346,3 +346,13 @@ (defmacro-mundanely lambda (&whole whole args &body body) (declare (ignore args body)) `#',whole) + +(defmacro-mundanely named-lambda (&whole whole name args &body body) + (declare (ignore name args body)) + `#',whole) + +(defmacro-mundanely lambda-with-lexenv (&whole whole + declarations macros symbol-macros + &body body) + (declare (ignore declarations macros symbol-macros body)) + `#',whole) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 2051486..a9af065 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -35,6 +35,9 @@ (values (svref (sb!c::debug-source-name source) 0) nil name)) + ;; FIXME: shouldn't these two clauses be the other way + ;; round? Using VALID-FUNCTION-NAME-P to see if we + ;; want to find an inline-expansion? ((stringp name) (values nil t name)) (t diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index d22a012..46c3dee 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -435,64 +435,22 @@ be a lambda expression." (if (consp thing) (case (car thing) - ((lambda) + ((lambda named-lambda instance-lambda lambda-with-lexenv) (reference-leaf start cont - (ir1-convert-lambda thing - :debug-name (debug-namify - "#'~S" thing) - :allow-debug-catch-tag t))) + (ir1-convert-lambdalike + thing + :debug-name (debug-namify "#'~S" thing) + :allow-debug-catch-tag t))) ((setf) (let ((var (find-lexically-apparent-fun thing "as the argument to FUNCTION"))) (reference-leaf start cont var))) - ((instance-lambda) - (let ((res (ir1-convert-lambda `(lambda ,@(cdr thing)) - :debug-name (debug-namify "#'~S" - thing) - :allow-debug-catch-tag t))) - (setf (getf (functional-plist res) :fin-function) t) - (reference-leaf start cont res))) (t (compiler-error "~S is not a legal function name." thing))) (let ((var (find-lexically-apparent-fun thing "as the argument to FUNCTION"))) (reference-leaf start cont var)))) - -;;; `(NAMED-LAMBDA ,NAME ,@REST) is like `(FUNCTION (LAMBDA ,@REST)), -;;; except that the value of NAME is passed to the compiler for use in -;;; creation of debug information for the resulting function. -;;; -;;; NAME can be a legal function name or some arbitrary other thing. -;;; -;;; If NAME is a legal function name, then the caller should be -;;; planning to set (FDEFINITION NAME) to the created function. -;;; (Otherwise the debug names will be inconsistent and thus -;;; unnecessarily confusing.) -;;; -;;; Arbitrary other things are appropriate for naming things which are -;;; not the FDEFINITION of NAME. E.g. -;;; NAME = (:FLET FOO BAR) -;;; for the FLET function in -;;; (DEFUN BAR (X) -;;; (FLET ((FOO (Y) (+ X Y))) -;;; FOO)) -;;; or -;;; NAME = (:METHOD PRINT-OBJECT :AROUND (STARSHIP T)) -;;; for the function used to implement -;;; (DEFMETHOD PRINT-OBJECT :AROUND ((SS STARSHIP) STREAM) ...). -(def-ir1-translator named-lambda ((name &rest rest) start cont) - (let* ((fun (if (legal-fun-name-p name) - (ir1-convert-lambda `(lambda ,@rest) - :source-name name - :allow-debug-catch-tag t) - (ir1-convert-lambda `(lambda ,@rest) - :debug-name name - :allow-debug-catch-tag t))) - (leaf (reference-leaf start cont fun))) - (when (legal-fun-name-p name) - (assert-global-function-definition-type name fun)) - leaf)) ;;;; FUNCALL diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index e6f917f..23405d4 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -1993,6 +1993,37 @@ (setf (functional-inline-expansion res) form) (setf (functional-arg-documentation res) (cadr form)) res))))) + +;;; helper for LAMBDA-like things, to massage them into a form +;;; suitable for IR1-CONVERT-LAMBDA. +;;; +;;; KLUDGE: We cons up a &REST list here, maybe for no particularly +;;; good reason. It's probably lost in the noise of all the other +;;; consing, but it's still inelegant. And we force our called +;;; functions to do full runtime keyword parsing, ugh. -- CSR, +;;; 2003-01-25 +(defun ir1-convert-lambdalike (thing &rest args + &key (source-name '.anonymous.) + debug-name allow-debug-catch-tag) + (ecase (car thing) + ((lambda) (apply #'ir1-convert-lambda thing args)) + ((instance-lambda) + (let ((res (apply #'ir1-convert-lambda + `(lambda ,@(cdr thing)) args))) + (setf (getf (functional-plist res) :fin-function) t) + res)) + ((named-lambda) + (let ((name (cadr thing))) + (if (legal-fun-name-p name) + (let ((res (apply #'ir1-convert-lambda `(lambda ,@(cddr thing)) + :source-name name + :debug-name nil + args))) + (assert-global-function-definition-type name res) + res) + (apply #'ir1-convert-lambda `(lambda ,@(cddr thing)) + :debug-name name args)))) + ((lambda-with-lexenv) (apply #'ir1-convert-inline-lambda thing args)))) ;;;; defining global functions @@ -2002,7 +2033,8 @@ ;;; reflect the state at the definition site. (defun ir1-convert-inline-lambda (fun &key (source-name '.anonymous.) - debug-name) + debug-name + allow-debug-catch-tag) (destructuring-bind (decls macros symbol-macros &rest body) (if (eq (car fun) 'lambda-with-lexenv) (cdr fun) @@ -2019,7 +2051,8 @@ :policy (lexenv-policy *lexenv*)))) (ir1-convert-lambda `(lambda ,@body) :source-name source-name - :debug-name debug-name)))) + :debug-name debug-name + :allow-debug-catch-tag nil)))) ;;; Get a DEFINED-FUN object for a function we are about to define. If ;;; the function has been forward referenced, then substitute for the diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index e8e62a6..e255974 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -871,7 +871,7 @@ (setf (component-name component) (debug-namify "~S initial component" name)) (setf (component-kind component) :initial) - (let* ((locall-fun (ir1-convert-lambda + (let* ((locall-fun (ir1-convert-lambdalike definition :debug-name (debug-namify "top level local call ~S" name) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index ff67c66..3423c37 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -744,6 +744,12 @@ ;; Unlike the SOURCE-NAME slot, this slot's value should never ;; affect ordinary code behavior, only debugging/diagnostic behavior. ;; + ;; Ha. Ah, the starry-eyed idealism of the writer of the above + ;; paragraph. FUNCTION-LAMBDA-EXPRESSION's behaviour, as of + ;; sbcl-0.7.11.x, differs if the name of the a function is a string + ;; or not, as if it is a valid function name then it can look for an + ;; inline expansion. + ;; ;; The value of this slot can be anything, except that it shouldn't ;; be a legal function name, since otherwise debugging gets ;; confusing. (If a legal function name is a good name for the diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index a43a80f..9a2aed6 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -752,6 +752,17 @@ BUG 48c, not yet fixed: (declare (type (vector (unsigned-byte 8)) x)) (setq *y* (the (unsigned-byte 8) (aref x 4)))) +;;; FUNCTION-LAMBDA-EXPRESSION should return something that's COMPILE +;;; can understand. Here's a simple test for that on a function +;;; that's likely to return a hairier list than just a lambda: +(macrolet ((def (fn) `(progn + (declaim (inline ,fn)) + (defun ,fn (x) (1+ x))))) + (def bug228)) +(let ((x (function-lambda-expression #'bug228))) + (when x + (assert (= (funcall (compile nil x) 1) 2)))) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 5e5f30e..f5ad5c8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.12.6" +"0.7.12.7" -- 1.7.10.4