- (fn (or (cdr (assq name byte-compile-function-environment))
- (and (fboundp name) (symbol-function name)))))
- (if (null fn)
- (progn
- (byte-compile-warn "attempt to inline `%s' before it was defined"
- name)
- form)
- ;; else
- (when (and (consp fn) (eq (car fn) 'autoload))
- (load (nth 1 fn))
- (setq fn (or (and (fboundp name) (symbol-function name))
- (cdr (assq name byte-compile-function-environment)))))
- (if (and (consp fn) (eq (car fn) 'autoload))
- (error "File `%s' didn't define `%s'" (nth 1 fn) name))
- (if (and (symbolp fn) (not (eq fn t)))
- (byte-compile-inline-expand (cons fn (cdr form)))
- (if (byte-code-function-p fn)
- (let (string)
- (fetch-bytecode fn)
- (setq string (aref fn 1))
- ;; Isn't it an error for `string' not to be unibyte?? --stef
- (if (fboundp 'string-as-unibyte)
- (setq string (string-as-unibyte string)))
- ;; `byte-compile-splice-in-already-compiled-code'
- ;; takes care of inlining the body.
- (cons `(lambda ,(aref fn 0)
- (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
- (cdr form)))
- (if (eq (car-safe fn) 'lambda)
- (macroexpand-all (cons fn (cdr form))
- byte-compile-macro-environment)
- ;; Give up on inlining.
- form))))))
+ (localfn (cdr (assq name byte-compile-function-environment)))
+ (fn (or localfn (and (fboundp name) (symbol-function name)))))
+ (when (and (consp fn) (eq (car fn) 'autoload))
+ (load (nth 1 fn))
+ (setq fn (or (and (fboundp name) (symbol-function name))
+ (cdr (assq name byte-compile-function-environment)))))
+ (pcase fn
+ (`nil
+ (byte-compile-warn "attempt to inline `%s' before it was defined"
+ name)
+ form)
+ (`(autoload . ,_)
+ (error "File `%s' didn't define `%s'" (nth 1 fn) name))
+ ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias.
+ (byte-compile-inline-expand (cons fn (cdr form))))
+ ((pred byte-code-function-p)
+ ;; (message "Inlining byte-code for %S!" name)
+ ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
+ `(,fn ,@(cdr form)))
+ ((or (and `(lambda ,args . ,body) (let env nil))
+ `(closure ,env ,args . ,body))
+ (if (not (or (eq fn localfn) ;From the same file => same mode.
+ (eq (not lexical-binding) (not env)))) ;Same mode.
+ ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
+ ;; letbind byte-code (or any other combination for that matter), we
+ ;; can only inline dynbind source into dynbind source or letbind
+ ;; source into letbind source.
+ ;; FIXME: we could of course byte-compile the inlined function
+ ;; first, and then inline its byte-code.
+ form
+ (let ((renv ()))
+ ;; Turn the function's closed vars (if any) into local let bindings.
+ (dolist (binding env)
+ (cond
+ ((consp binding)
+ ;; We check shadowing by the args, so that the `let' can be
+ ;; moved within the lambda, which can then be unfolded.
+ ;; FIXME: Some of those bindings might be unused in `body'.
+ (unless (memq (car binding) args) ;Shadowed.
+ (push `(,(car binding) ',(cdr binding)) renv)))
+ ((eq binding t))
+ (t (push `(defvar ,binding) body))))
+ (let ((newfn (byte-compile-preprocess
+ (if (null renv)
+ `(lambda ,args ,@body)
+ `(lambda ,args (let ,(nreverse renv) ,@body))))))
+ (if (eq (car-safe newfn) 'function)
+ (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+ (byte-compile-log-warning
+ (format "Inlining closure %S failed" name))
+ form)))))
+
+ (t ;; Give up on inlining.
+ form))))