From: Stefan Monnier Date: Tue, 9 Feb 2021 17:10:07 +0000 (-0500) Subject: * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro X-Git-Tag: emacs-28.0.90~3851 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6fd8548b1620aadd2c9e4efddd899b87d023913b;p=emacs.git * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro (byte-optimize-form-code-walker): Use it. --- diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e67077639c2..4fa2c75a889 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 ) --> . (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)))