((or `(lambda . ,_) `(closure . ,_))
;; 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.
+ ;; can only inline dynbind source into dynbind source or lexbind
+ ;; source into lexbind source.
;; When the function comes from another file, we byte-compile
;; the inlined function first, and then inline its byte-code.
;; This also has the advantage that the final code does not
;; the build more reproducible.
(if (eq fn localfn)
;; From the same file => same mode.
- (macroexp--unfold-lambda `(,fn ,@(cdr form)))
+ (let* ((newform `(,fn ,@(cdr form)))
+ (unfolded (macroexp--unfold-lambda newform)))
+ ;; Use the newform only if it could be optimized.
+ (if (eq unfolded newform) form unfolded))
;; Since we are called from inside the optimizer, we need to make
;; sure not to propagate lexvar values.
(let ((byte-optimize--lexvars nil)
`(progn ,@(byte-optimize-body env t))
`(,fn ,vars ,(mapcar #'byte-optimize-form env) . ,rest)))
- (`((lambda . ,_) . ,_)
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion.
- form
- (byte-optimize-form newform for-effect))))
-
(`(setq ,var ,expr)
(let ((lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(defun byte-optimize-funcall (form)
- ;; (funcall #'(lambda ...) ...) -> ((lambda ...) ...)
+ ;; (funcall #'(lambda ...) ...) -> (let ...)
;; (funcall #'SYM ...) -> (SYM ...)
;; (funcall 'SYM ...) -> (SYM ...)
- (let* ((fn (nth 1 form))
- (head (car-safe fn)))
- (if (or (eq head 'function)
- (and (eq head 'quote) (symbolp (nth 1 fn))))
- (cons (nth 1 fn) (cdr (cdr form)))
- form)))
+ (pcase form
+ (`(,_ #'(lambda . ,_) . ,_)
+ (macroexp--unfold-lambda form))
+ (`(,_ ,(or `#',f `',(and f (pred symbolp))) . ,actuals)
+ `(,f ,@actuals))
+ (_ form)))
(defun byte-optimize-apply (form)
(let ((len (length form)))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
- ;; In lexical-binding mode, let and functions don't bind vars in the same way
- ;; (let obey special-variable-p, but functions don't). But luckily, this
- ;; doesn't matter here, because function's behavior is underspecified so it
- ;; can safely be turned into a `let', even though the reverse is not true.
(or name (setq name "anonymous lambda"))
- (let* ((lambda (car form))
- (values (cdr form))
- (arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "Multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "Nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "Nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "Multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (macroexp-warn-and-return
- (format-message
- (if (eq values 'too-few)
- "attempt to open-code `%s' with too few arguments"
- "attempt to open-code `%s' with too many arguments")
- name)
- form nil nil arglist)
-
- ;; The following leads to infinite recursion when loading a
- ;; file containing `(defsubst f () (f))', and then trying to
- ;; byte-compile that file.
- ;;(setq body (mapcar 'byte-optimize-form body)))
-
- (if bindings
- `(let ,(nreverse bindings) . ,body)
- (macroexp-progn body)))))
+ (pcase form
+ ((or `(funcall (function ,lambda) . ,actuals) `(,lambda . ,actuals))
+ (let* ((formals (nth 1 lambda))
+ (body (cdr (macroexp-parse-body (cddr lambda))))
+ optionalp restp
+ (dynboundarg nil)
+ bindings)
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while formals
+ (if (macroexp--dynamic-variable-p (car formals))
+ (setq dynboundarg t))
+ (cond ((eq (car formals) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "Multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr formals))
+ (error "Nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car formals) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in formalss.
+ (if (null (cdr formals))
+ (error "Nothing after &rest in %s" name))
+ (if (cdr (cdr formals))
+ (error "Multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car formals)
+ (and actuals (cons 'list actuals)))
+ bindings)
+ actuals nil))
+ ((and (not optionalp) (null actuals))
+ (setq formals nil actuals 'too-few))
+ (t
+ (setq bindings (cons (list (car formals) (car actuals))
+ bindings)
+ actuals (cdr actuals))))
+ (setq formals (cdr formals)))
+ (cond
+ (actuals
+ (macroexp-warn-and-return
+ (format-message
+ (if (eq actuals 'too-few)
+ "attempt to open-code `%s' with too few arguments"
+ "attempt to open-code `%s' with too many arguments")
+ name)
+ form nil nil formals))
+ ;; In lexical-binding mode, let and functions don't bind vars in
+ ;; the same way (let obey special-variable-p, but functions
+ ;; don't). So if one of the vars is declared as dynamically scoped, we
+ ;; can't just convert the call to `let'.
+ ;; FIXME: We should α-rename the affected args and then use `let'.
+ (dynboundarg form)
+ (bindings `(let ,(nreverse bindings) . ,body))
+ (t (macroexp-progn body)))))
+ (_ (error "Not an unfoldable form: %S" form))))
(defun macroexp--dynamic-variable-p (var)
"Whether the variable VAR is dynamically scoped.
(setq args (cddr args)))
(cons 'progn (nreverse assignments))))))
(`(,(and fun `(lambda . ,_)) . ,args)
- ;; Embedded lambda in function position.
- ;; If the byte-optimizer is loaded, try to unfold this,
- ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
- ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
- ;; creation of a closure, thus resulting in much better code.
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Unfolding failed for some reason, avoid infinite recursion.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form)
- (macroexp--expand-all newform))))
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form))
(`(funcall ,exp . ,args)
(let ((eexp (macroexp--expand-all exp))
(eargs (macroexp--all-forms args)))
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro, or to unfold it.
(pcase eexp
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
((and `#',f
- (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
+ (guard (and (symbolp f)
+ ;; bug#46636
+ (not (or (special-form-p f) (macrop f))))))
(macroexp--expand-all `(,f . ,eargs)))
+ (`#'(lambda . ,_)
+ (macroexp--unfold-lambda `(,fn ,eexp . ,eargs)))
(_ `(,fn ,eexp . ,eargs)))))
(`(funcall . ,_) form) ;bug#53227
(`(,func . ,_)
projects / emacs.git / commitdiff