X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=0c1ce53595fa638e094140cee2e48fc1e81bd1c1;hb=23a229276c2447a658b7a30217ec774067c27d5e;hp=7b671c479e936d85d2260256d82bd58226789840;hpb=a0889b188cadcbb5c5fde6807662ea299e6c134d;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 7b671c4..0c1ce53 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -870,19 +870,21 @@
 ;;; *TOPLEVEL-LAMBDAS* instead.
 (defun convert-and-maybe-compile (form path)
   (declare (list path))
-  (if (fopcompilable-p form)
-      (let ((*fopcompile-label-counter* 0))
-        (fopcompile form path nil))
-      (let* ((*top-level-form-noted* (note-top-level-form form t))
-             (*lexenv* (make-lexenv
-                        :policy *policy*
-                        :handled-conditions *handled-conditions*
-                        :disabled-package-locks *disabled-package-locks*))
-             (tll (ir1-toplevel form path nil)))
-        (if (eq *block-compile* t)
-            (push tll *toplevel-lambdas*)
-            (compile-toplevel (list tll) nil))
-        nil)))
+  (let ((*top-level-form-noted* (note-top-level-form form t)))
+    ;; Don't bother to compile simple objects that just sit there.
+    (when (and form (or (symbolp form) (consp form)))
+      (if (fopcompilable-p form)
+         (let ((*fopcompile-label-counter* 0))
+           (fopcompile form path nil))
+         (let ((*lexenv* (make-lexenv
+                          :policy *policy*
+                          :handled-conditions *handled-conditions*
+                          :disabled-package-locks *disabled-package-locks*))
+               (tll (ir1-toplevel form path nil)))
+           (if (eq *block-compile* t)
+               (push tll *toplevel-lambdas*)
+               (compile-toplevel (list tll) nil))
+           nil)))))
 
 ;;; Macroexpand FORM in the current environment with an error handler.
 ;;; We only expand one level, so that we retain all the intervening
@@ -971,7 +973,7 @@
                            (maybe-frob (optional-dispatch-main-entry f)))
                          result))))
 
-(defun make-functional-from-toplevel-lambda (definition
+(defun make-functional-from-toplevel-lambda (lambda-expression
                                              &key
                                              name
                                              (path
@@ -981,17 +983,15 @@
                                               (missing-arg)))
   (let* ((*current-path* path)
          (component (make-empty-component))
-         (*current-component* component))
-    (setf (component-name component)
-          (debug-name 'initial-component name))
-    (setf (component-kind component) :initial)
+         (*current-component* component)
+         (debug-name-tail (or name (name-lambdalike lambda-expression)))
+         (source-name (or name '.anonymous.)))
+    (setf (component-name component) (debug-name 'initial-component debug-name-tail)
+          (component-kind component) :initial)
     (let* ((locall-fun (let ((*allow-instrumenting* t))
                          (funcall #'ir1-convert-lambdalike
-                                  definition
-                                  :source-name name)))
-           (debug-name (debug-name 'tl-xep
-                                   (or name
-                                       (functional-%source-name locall-fun))))
+                                  lambda-expression
+                                  :source-name source-name)))
            ;; Convert the XEP using the policy of the real
            ;; function. Otherwise the wrong policy will be used for
            ;; deciding whether to type-check the parameters of the
@@ -1000,8 +1000,8 @@
            (*lexenv* (make-lexenv :policy (lexenv-policy
                                            (functional-lexenv locall-fun))))
            (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun)
-                                    :source-name (or name '.anonymous.)
-                                    :debug-name debug-name)))
+                                    :source-name source-name
+                                    :debug-name (debug-name 'tl-xep debug-name-tail))))
       (when name
         (assert-global-function-definition-type name locall-fun))
       (setf (functional-entry-fun fun) locall-fun
@@ -1150,7 +1150,7 @@
   (declare (list path))
 
   (catch 'process-toplevel-form-error-abort
-    (let* ((path (or (gethash form *source-paths*) (cons form path)))
+    (let* ((path (or (get-source-path form) (cons form path)))
            (*compiler-error-bailout*
             (lambda (&optional condition)
               (convert-and-maybe-compile