- (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* (;; stuff shared between LAMBDA and INLINE-LAMBDA and NAMED-LAMBDA
+ (lambda-guts `(,args
+ ,@decls
+ (block ,(fun-name-block-name name)
+ ,@forms)))
+ (lambda `(lambda ,@lambda-guts))
+ #-sb-xc-host
+ (named-lambda `(named-lambda ,name ,@lambda-guts))
+ (inline-lambda
+ (when (inline-fun-name-p name)
+ ;; we want to attempt to inline, so complain if we can't
+ (or (sb!c:maybe-inline-syntactic-closure lambda env)
+ (progn
+ (#+sb-xc-host warn
+ #-sb-xc-host sb!c:maybe-compiler-note
+ "lexical environment too hairy, can't inline DEFUN ~S"
+ name)
+ nil)))))
+ `(progn
+
+ ;; In cross-compilation of toplevel DEFUNs, we arrange
+ ;; for the LAMBDA to be statically linked by GENESIS.
+ ;;
+ ;; It may seem strangely inconsistent not to use NAMED-LAMBDA
+ ;; here instead of LAMBDA. The reason is historical:
+ ;; COLD-FSET was written before NAMED-LAMBDA, and has special
+ ;; logic of its own to notify the compiler about NAME.
+ #+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 ,named-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)))
+ (aver (legal-fun-name-p name)) ; should've been checked by DEFMACRO DEFUN
+ (when (fboundp name)
+ (/show0 "redefining NAME in %DEFUN")
+ (style-warn "redefining ~S in DEFUN" name))
+ (setf (sb!xc:fdefinition name) def)
+
+ ;; FIXME: I want to do this here (and fix bug 137), but until the
+ ;; breathtaking CMU CL function name architecture is converted into
+ ;; something sane, (1) doing so doesn't really fix the bug, and
+ ;; (2) doing probably isn't even really safe.
+ #+nil (setf (%fun-name def) name)
+
+ (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 (the symbol name) 'function) doc)))