- (let ((def `(lambda ,args
- ,@decls
- (block ,(function-name-block-name name)
- ,@forms))))
- `(sb!c::%defun ',name #',def ,doc ',whole))))
-#+sb-xc-host (/show "before PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun))
-#+sb-xc-host (sb!xc:proclaim '(ftype function sb!c::%%defun)) ; to avoid
- ; undefined function warnings
-#+sb-xc-host (/show "after PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun))
-(defun sb!c::%%defun (name def doc &optional inline-expansion)
- ;; When we're built as a cross-compiler, the DEF is a function
- ;; implemented by the cross-compilation host, which is opaque to us.
- ;; Similarly, other things like FDEFINITION or DOCUMENTATION either
- ;; aren't ours to mess with or are meaningless to mess with. Thus,
- ;; we punt.
- #+sb-xc-host (declare (ignore def doc))
- #-sb-xc-host
- (progn
- (when (fboundp name)
- (style-warn "redefining ~S in DEFUN" name))
- (setf (sb!xc:fdefinition name) def)
- (when doc
- ;; FIXME: This should use shared SETF-name-parsing logic.
- (if (and (consp name) (eq (first name) 'setf))
- (setf (fdocumentation (second name) 'setf) doc)
- (setf (fdocumentation name 'function) doc))))
- ;; Other stuff remains meaningful whether we're cross-compiling or
- ;; native compiling.
- (become-defined-function-name name)
- (when (or inline-expansion
- (info :function :inline-expansion name))
- (setf (info :function :inline-expansion name)
- inline-expansion))
- ;; Voila.
+ (let* ((lambda `(lambda ,args
+ ,@decls
+ (block ,(function-name-block-name name)
+ ,@forms)))
+ (want-to-inline )
+ (inline-lambda
+ (cond (;; Does the user not even want to inline?
+ (not (inline-function-name-p name))
+ nil)
+ (;; Does inlining look too hairy to handle?
+ (not (sb!c:lambda-independent-of-lexenv-p lambda env))
+ (sb!c:maybe-compiler-note
+ "lexical environment too hairy, can't inline DEFUN ~S"
+ name)
+ nil)
+ (t
+ ;; FIXME: The only reason that we return
+ ;; LAMBDA-WITH-LEXENV instead of returning bare
+ ;; LAMBDA is to avoid modifying downstream code
+ ;; which expects LAMBDA-WITH-LEXENV. But the code
+ ;; here is the only code which feeds into the
+ ;; downstream code, and the generality of the
+ ;; interface is no longer used, so it'd make sense
+ ;; to simplify the interface instead of using the
+ ;; old general LAMBDA-WITH-LEXENV interface in this
+ ;; simplified way.
+ `(sb!c:lambda-with-lexenv
+ nil nil nil ; i.e. no DECLS, no MACROS, no SYMMACS
+ ,@(rest lambda))))))
+ `(progn
+
+ ;; In cross-compilation of toplevel DEFUNs, we arrange
+ ;; for the LAMBDA to be statically linked by GENESIS.
+ #+sb-xc-host
+ (cold-fset ,name ,lambda)
+
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (sb!c:%compiler-defun ',name ',inline-lambda))
+
+ (%defun ',name
+ ;; In normal compilation (not for cold load) this is
+ ;; where the compiled LAMBDA first appears. In
+ ;; cross-compilation, we manipulate the
+ ;; previously-statically-linked LAMBDA here.
+ #-sb-xc-host ,lambda
+ #+sb-xc-host (fdefinition ',name)
+ ,doc)))))
+#-sb-xc-host
+(defun %defun (name def doc)
+ (declare (type function def))
+ (declare (type (or null simple-string doc)))
+ (/show0 "entering %DEFUN, name (or block name) = ..")
+ (/primitive-print (symbol-name (function-name-block-name name)))
+ (aver (legal-function-name-p name))
+ (when (fboundp name)
+ (/show0 "redefining NAME")
+ (style-warn "redefining ~S in DEFUN" name))
+ (/show0 "setting FDEFINITION")
+ (setf (sb!xc:fdefinition name) def)
+ (when doc
+ ;; FIXME: This should use shared SETF-name-parsing logic.
+ (/show0 "setting FDOCUMENTATION")
+ (if (and (consp name) (eq (first name) 'setf))
+ (setf (fdocumentation (second name) 'setf) doc)
+ (setf (fdocumentation (the symbol name) 'function) doc)))
+ (/show0 "leaving %DEFUN")