From 6498af7fdc48d9bf5df33e75d7e4d385893feb06 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 2 Dec 2002 14:24:45 +0000 Subject: [PATCH] 0.7.10.7: Improve FUNCTION-LAMBDA-EXPRESSION marginally, to help in getting INLINE-inside-MACROLET working in the target compiler ... associate the function with the debug-source where possible ... we now store (LAMBDA ...), not (FUNCTION (LAMBDA ...)), so remove the bogus SECOND --- src/code/target-misc.lisp | 2 +- src/compiler/main.lisp | 83 ++++++++++++++++++++++++++------------------- tests/compiler.pure.lisp | 9 +++++ version.lisp-expr | 2 +- 4 files changed, 59 insertions(+), 37 deletions(-) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index a021148..2051486 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -32,7 +32,7 @@ (let ((source (first (sb!c::compiled-debug-info-source info)))) (cond ((and (eq (sb!c::debug-source-from source) :lisp) (eq (sb!c::debug-source-info source) fun)) - (values (second (svref (sb!c::debug-source-name source) 0)) + (values (svref (sb!c::debug-source-name source) 0) nil name)) ((stringp name) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index a99e5ba..01bca3a 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -937,41 +937,54 @@ (compile-component component-from-dfo) (replace-toplevel-xeps component-from-dfo))) - (prog1 - (let ((entry-table (etypecase *compile-object* - (fasl-output (fasl-output-entry-table - *compile-object*)) - (core-object (core-object-entry-table - *compile-object*))))) - (multiple-value-bind (result found-p) - (gethash (leaf-info fun) entry-table) - (aver found-p) - result)) - ;; KLUDGE: This code duplicates some other code in this - ;; file. In the great reorganzation, the flow of program logic - ;; changed from the original CMUCL model, and that path (as of - ;; sbcl-0.7.5 in SUB-COMPILE-FILE) was no longer followed for - ;; CORE-OBJECTS, leading to BUG 156. This place is - ;; transparently not the right one for this code, but I don't - ;; have a clear enough overview of the compiler to know how to - ;; rearrange it all so that this operation fits in nicely, and - ;; it was blocking reimplementation of - ;; (DECLAIM (INLINE FOO)) (MACROLET ((..)) (DEFUN FOO ...)) - ;; - ;; FIXME: This KLUDGE doesn't solve all the problem in an - ;; ideal way, as (1) definitions typed in at the REPL without - ;; an INLINE declaration will give a NULL - ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal) and - ;; (2) INLINE declarations will yield a - ;; FUNCTION-LAMBDA-EXPRESSION headed by - ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV. - ;; - ;; CSR, 2002-07-02 - (when (core-object-p *compile-object*) - (fix-core-source-info *source-info* *compile-object*)) - - (mapc #'clear-ir1-info components-from-dfo) - (clear-stuff))))) + (let ((entry-table (etypecase *compile-object* + (fasl-output (fasl-output-entry-table + *compile-object*)) + (core-object (core-object-entry-table + *compile-object*))))) + (multiple-value-bind (result found-p) + (gethash (leaf-info fun) entry-table) + (aver found-p) + (prog1 + result + ;; KLUDGE: This code duplicates some other code in this + ;; file. In the great reorganzation, the flow of program + ;; logic changed from the original CMUCL model, and that + ;; path (as of sbcl-0.7.5 in SUB-COMPILE-FILE) was no + ;; longer followed for CORE-OBJECTS, leading to BUG + ;; 156. This place is transparently not the right one for + ;; this code, but I don't have a clear enough overview of + ;; the compiler to know how to rearrange it all so that + ;; this operation fits in nicely, and it was blocking + ;; reimplementation of (DECLAIM (INLINE FOO)) (MACROLET + ;; ((..)) (DEFUN FOO ...)) + ;; + ;; FIXME: This KLUDGE doesn't solve all the problem in an + ;; ideal way, as (1) definitions typed in at the REPL + ;; without an INLINE declaration will give a NULL + ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal) + ;; and (2) INLINE declarations will yield a + ;; FUNCTION-LAMBDA-EXPRESSION headed by + ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV. -- CSR, + ;; 2002-07-02 + ;; + ;; (2) is probably fairly easy to fix -- it is, after all, + ;; a matter of list manipulation (or possibly of teaching + ;; CL:FUNCTION about SB-C:LAMBDA-WITH-LEXENV). (1) is + ;; significantly harder, as the association between + ;; function object and source is a tricky one. + ;; + ;; FUNCTION-LAMBDA-EXPRESSION "works" (i.e. returns a + ;; non-NULL list) when the function in question has been + ;; compiled by (COMPILE '(LAMBDA ...)); it does not + ;; work when it has been compiled as part of the top-level + ;; EVAL strategy of compiling everything inside (LAMBDA () + ;; ...). -- CSR, 2002-11-02 + (when (core-object-p *compile-object*) + (fix-core-source-info *source-info* *compile-object* result)) + + (mapc #'clear-ir1-info components-from-dfo) + (clear-stuff))))))) (defun process-toplevel-cold-fset (name lambda-expression path) (unless (producing-fasl-file) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 3ee09af..3d87d16 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -274,3 +274,12 @@ (let ((v (make-array 0 :fill-pointer 0))) (vector-push-extend 1 v) (copy-seq v)))) + +;;; to support INLINE functions inside MACROLET, it is necessary for +;;; FUNCTION-LAMBDA-EXPRESSION to return a proper lambda expression in +;;; certain circumstances, one of which is when compile is called from +;;; top-level. +(assert (equal + (function-lambda-expression + (compile nil '(lambda (x) (block nil (print x))))) + '(lambda (x) (block nil (print x))))) diff --git a/version.lisp-expr b/version.lisp-expr index 35cad48..2e5748d 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.10.6" +"0.7.10.7" -- 1.7.10.4