diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 30 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/disass.el | 23 | ||||
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 143 |
5 files changed, 95 insertions, 113 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 307e3841e9b..26a1dc4a103 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -167,8 +167,8 @@ Earlier variables shadow later ones with the same name.") ((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 @@ -176,7 +176,10 @@ Earlier variables shadow later ones with the same name.") ;; 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) @@ -452,13 +455,6 @@ for speeding up processing.") `(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))) @@ -1412,15 +1408,15 @@ See Info node `(elisp) Integer Basics'." (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))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0d878846304..64a57948017 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3556,12 +3556,6 @@ lambda-expression." ((and (byte-code-function-p (car form)) (memq byte-optimize '(t lap))) (byte-compile-unfold-bcf form)) - ((and (eq (car-safe (car form)) 'lambda) - ;; if the form comes out the same way it went in, that's - ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (macroexp--unfold-lambda form))))) - (byte-compile-form form byte-compile--for-effect) - (setq byte-compile--for-effect nil)) ((byte-compile-normal-call form))) (if byte-compile--for-effect (byte-compile-discard)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 540bcc7f3b3..1de5409f7ee 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -251,10 +251,8 @@ The name is made by appending a number to PREFIX, default \"T\"." (if (macroexp--dynamic-variable-p (car binding)) (setq dyn t))) (cond (dyn - ;; FIXME: We use `identity' to obfuscate the code enough to - ;; circumvent the known bug in `macroexp--unfold-lambda' :-( - `(funcall (identity (lambda (,@(mapcar #'car bindings)) - ,@(macroexp-unprogn body))) + `(funcall (lambda (,@(mapcar #'car bindings)) + ,@(macroexp-unprogn body)) ,@(mapcar #'cadr bindings))) ((null (cdr bindings)) (macroexp-let* bindings body)) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9dd08d00920..dd59a2e02e1 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -63,16 +63,19 @@ redefine OBJECT if it is a symbol." (list (intern (completing-read (format-prompt "Disassemble function" fn) obarray 'fboundp t nil nil def)) nil 0 t))) - (if (and (consp object) (not (functionp object))) - (setq object `(lambda () ,object))) - (or indent (setq indent 0)) ;Default indent to zero - (save-excursion - (if (or interactive-p (null buffer)) - (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") - (disassemble-internal object indent (not interactive-p))) - (set-buffer buffer) - (disassemble-internal object indent nil))) + (let ((lb lexical-binding)) + (if (and (consp object) (not (functionp object))) + (setq object `(lambda () ,object))) + (or indent (setq indent 0)) ;Default indent to zero + (save-excursion + (if (or interactive-p (null buffer)) + (with-output-to-temp-buffer "*Disassemble*" + (set-buffer "*Disassemble*") + (let ((lexical-binding lb)) + (disassemble-internal object indent (not interactive-p)))) + (set-buffer buffer) + (let ((lexical-binding lb)) + (disassemble-internal object indent nil))))) nil) (declare-function native-comp-unit-file "data.c") diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index f3d0804323e..290bf1c933a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -244,68 +244,64 @@ It should normally be a symbol with position and it defaults to 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. @@ -437,27 +433,22 @@ Assumes the caller has bound `macroexpand-all-environment'." (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 . ,_) |