;;; *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
(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
(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
(*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
(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