X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=6b3debf8cd5315cc16d1fc3110d725176fad023f;hb=77ab3779bb218e5c3080304fddefb3956b209547;hp=a99e5ba0034a12b8bc0b6e98d2b5fde2b267090b;hpb=cf607a404d7518e8a18c9e362913f370eb9a5e38;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index a99e5ba..6b3debf 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -121,6 +121,7 @@
   `(%with-compilation-unit (lambda () ,@body) ,@options))
 
 (defun %with-compilation-unit (fn &key override)
+  (declare (type function fn))
   (let ((succeeded-p nil))
     (if (and *in-compilation-unit* (not override))
 	;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is
@@ -937,41 +938,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 <x> '(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)