[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 6fd8548: * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): Ne
From: |
Stefan Monnier |
Subject: |
master 6fd8548: * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro |
Date: |
Tue, 9 Feb 2021 12:10:12 -0500 (EST) |
branch: master
commit 6fd8548b1620aadd2c9e4efddd899b87d023913b
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro
(byte-optimize-form-code-walker): Use it.
---
lisp/emacs-lisp/byte-opt.el | 70 ++++++++++++++++++++++++++++++++-------------
1 file changed, 50 insertions(+), 20 deletions(-)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e670776..4fa2c75 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -348,6 +348,40 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(symbolp (cadr expr)))
(keywordp expr)))
+(defmacro byte-optimize--pcase (exp &rest cases)
+ ;; When we do
+ ;;
+ ;; (pcase EXP
+ ;; (`(if ,exp ,then ,else) (DO-TEST))
+ ;; (`(plus ,e2 ,e2) (DO-ADD))
+ ;; (`(times ,e2 ,e2) (DO-MULT))
+ ;; ...)
+ ;;
+ ;; we usually don't want to fall back to the default case if
+ ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)'
+ ;; or `(times E1 E2 E3)', instead we either want to signal an error
+ ;; that EXP has an unexpected shape, or we want to carry on as if
+ ;; it had the right shape (ignore the extra data and pretend the missing
+ ;; data is nil) because it should simply never happen.
+ ;;
+ ;; The macro below implements the second option by rewriting patterns
+ ;; like `(if ,exp ,then ,else)'
+ ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'.
+ ;;
+ ;; The resulting macroexpansion is also significantly cleaner/smaller/faster.
+ (declare (indent 1) (debug (form &rest (pcase-PAT body))))
+ `(pcase ,exp
+ . ,(mapcar (lambda (case)
+ `(,(pcase (car case)
+ ((and `(,'\` (,_ . (,'\, ,_))) pat) pat)
+ (`(,'\` (,head . ,tail))
+ (list '\`
+ (cons head
+ (list '\, `(or ,(list '\` tail)
pcase--dontcare)))))
+ (pat pat))
+ . ,(cdr case)))
+ cases)))
+
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@@ -360,7 +394,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
- (pcase form
+ (byte-optimize--pcase form
((pred (not consp))
(cond
((and for-effect
@@ -370,7 +404,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
- (if (cddr lexvar) ; Value available?
+ (if (cddr lexvar) ; Value available?
(if (assq form byte-optimize--vars-outside-loop)
;; Cannot substitute; mark for retention to avoid the
;; variable being eliminated.
@@ -390,27 +424,27 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(not for-effect)
form))
(`(,(or 'let 'let*) . ,rest)
- (cons fn (byte-optimize-let-form fn rest for-effect)))
+ (cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
;; The condition in the first clause is always executed, but
;; right now we treat all of them as conditional for simplicity.
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
(cons fn
(mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- clauses))))
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses))))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
- (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
+ (`(prog1 ,exp . ,exps)
(if exps
`(prog1 ,(byte-optimize-form exp for-effect)
. ,(byte-optimize-body exps t))
@@ -435,8 +469,6 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(then-opt (byte-optimize-form then for-effect))
(else-opt (byte-optimize-body else for-effect)))
`(if ,test-opt ,then-opt . ,else-opt)))
- (`(if . ,_)
- (byte-compile-warn "too few arguments for `if'"))
(`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
;; FIXME: We have to traverse the expressions in left-to-right
@@ -474,8 +506,6 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(body (byte-optimize-body exps t)))
`(while ,condition . ,body)))
- (`(while . ,_)
- (byte-compile-warn "too few arguments for `while'"))
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
@@ -487,9 +517,9 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; all the subexpressions and compiling them separately.
form)
- (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
+ (`(condition-case ,var ,exp . ,clauses)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
- `(condition-case ,var ;Not evaluated.
+ `(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
@@ -513,7 +543,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
`(unwind-protect ,bodyform
. ,(byte-optimize-body exps t))))))
- (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
+ (`(catch ,tag . ,exps)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect))))
@@ -566,7 +596,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(setcdr (cdr lexvar)
(and (byte-optimize--substitutable-p value)
(list value))))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t)) ; Mark variable to be kept.
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 6fd8548: * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro,
Stefan Monnier <=