Skip to content

GitLab

Commit 25e1b732 authored by Stefan Monnier's avatar Stefan Monnier
Browse files
Options

* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Use pcase

parent 0ab56a4e
Pipeline #8781 failed with stages
                in 31 minutes and 10 seconds
                Hide whitespace changes
                Inline Side-by-side
                Showing with 175 additions and 176 deletions
                lisp/emacs-lisp/byte-opt.el
                View file @ 25e1b732
                ......@@ -374,185 +374,184 @@
                ;; the important aspect is that they are subrs that don't evaluate all of
                ;; their args.)
                ;;
                (let ((fn (car-safe form))
                tmp)
                (cond ((not (consp form))
                (if (not (and for-effect
                (or byte-compile-delete-errors
                (not (symbolp form))
                (eq form t))))
                form))
                ((eq fn 'quote)
                (if (cdr (cdr form))
                (byte-compile-warn "malformed quote form: `%s'"
                (prin1-to-string form)))
                ;; map (quote nil) to nil to simplify optimizer logic.
                ;; map quoted constants to nil if for-effect (just because).
                (and (nth 1 form)
                (not for-effect)
                form))
                ((memq fn '(let let*))
                ;; recursively enter the optimizer for the bindings and body
                ;; of a let or let*. This for depth-firstness: forms that
                ;; are more deeply nested are optimized first.
                (cons fn
                ;; FIXME: There are a bunch of `byte-compile-warn' here which arguably
                ;; 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
                ((pred (not consp))
                (if (not (and for-effect
                (or byte-compile-delete-errors
                (not (symbolp form))
                (eq form t))))
                form))
                (`(quote . ,v)
                (if (cdr v)
                (byte-compile-warn "malformed quote form: `%s'"
                (prin1-to-string form)))
                ;; Map (quote nil) to nil to simplify optimizer logic.
                ;; Map quoted constants to nil if for-effect (just because).
                (and (car v)
                (not for-effect)
                form))
                (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare))
                ;; Recursively enter the optimizer for the bindings and body
                ;; of a let or let*. This for depth-firstness: forms that
                ;; are more deeply nested are optimized first.
                (cons fn
                (cons
                (mapcar (lambda (binding)
                (if (symbolp binding)
                binding
                (if (cdr (cdr binding))
                (byte-compile-warn "malformed let binding: `%s'"
                (prin1-to-string binding)))
                (list (car binding)
                (byte-optimize-form (nth 1 binding) nil))))
                (nth 1 form))
                (byte-optimize-body (cdr (cdr form)) for-effect))))
                ((eq fn 'cond)
                (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))
                (cdr form))))
                ((eq fn 'progn)
                ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
                (if (cdr (cdr form))
                (macroexp-progn (byte-optimize-body (cdr form) for-effect))
                (byte-optimize-form (nth 1 form) for-effect)))
                ((eq fn 'prog1)
                (if (cdr (cdr form))
                (cons 'prog1
                (cons (byte-optimize-form (nth 1 form) for-effect)
                (byte-optimize-body (cdr (cdr form)) t)))
                (byte-optimize-form (nth 1 form) for-effect)))
                ((memq fn '(save-excursion save-restriction save-current-buffer))
                ;; those subrs which have an implicit progn; it's not quite good
                ;; enough to treat these like normal function calls.
                ;; This can turn (save-excursion ...) into (save-excursion) which
                ;; will be optimized away in the lap-optimize pass.
                (cons fn (byte-optimize-body (cdr form) for-effect)))
                ((eq fn 'if)
                (when (< (length form) 3)
                (byte-compile-warn "too few arguments for `if'"))
                (cons fn
                (cons (byte-optimize-form (nth 1 form) nil)
                (cons
                (byte-optimize-form (nth 2 form) for-effect)
                (byte-optimize-body (nthcdr 3 form) for-effect)))))
                ((memq fn '(and or)) ; Remember, and/or are control structures.
                ;; Take forms off the back until we can't any more.
                ;; In the future it could conceivably be a problem that the
                ;; subexpressions of these forms are optimized in the reverse
                ;; order, but it's ok for now.
                (if for-effect
                (let ((backwards (reverse (cdr form))))
                (while (and backwards
                (null (setcar backwards
                (byte-optimize-form (car backwards)
                for-effect))))
                (setq backwards (cdr backwards)))
                (if (and (cdr form) (null backwards))
                (byte-compile-log
                " all subforms of %s called for effect; deleted" form))
                (and backwards
                (cons fn (nreverse (mapcar 'byte-optimize-form
                backwards)))))
                (cons fn (mapcar 'byte-optimize-form (cdr form)))))
                ((eq fn 'while)
                (unless (consp (cdr form))
                (byte-compile-warn "too few arguments for `while'"))
                (cons fn
                (cons (byte-optimize-form (cadr form) nil)
                (byte-optimize-body (cddr form) t))))
                ((eq fn 'interactive)
                (byte-compile-warn "misplaced interactive spec: `%s'"
                (prin1-to-string form))
                nil)
                ((eq fn 'function)
                ;; This forms is compiled as constant or by breaking out
                ;; all the subexpressions and compiling them separately.
                form)
                ((eq fn 'condition-case)
                `(condition-case ,(nth 1 form) ;Not evaluated.
                ,(byte-optimize-form (nth 2 form) for-effect)
                ,@(mapcar (lambda (clause)
                `(,(car clause)
                ,@(byte-optimize-body (cdr clause) for-effect)))
                (nthcdr 3 form))))
                ((eq fn 'unwind-protect)
                ;; the "protected" part of an unwind-protect is compiled (and thus
                ;; optimized) as a top-level form, so don't do it here. But the
                ;; non-protected part has the same for-effect status as the
                ;; unwind-protect itself. (The protected part is always for effect,
                ;; but that isn't handled properly yet.)
                (cons fn
                (cons (byte-optimize-form (nth 1 form) for-effect)
                (cdr (cdr form)))))
                ((eq fn 'catch)
                (cons fn
                (cons (byte-optimize-form (nth 1 form) nil)
                (byte-optimize-body (cdr form) for-effect))))
                ((eq fn 'ignore)
                ;; Don't treat the args to `ignore' as being
                ;; computed for effect. We want to avoid the warnings
                ;; that might occur if they were treated that way.
                ;; However, don't actually bother calling `ignore'.
                `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
                ;; Needed as long as we run byte-optimize-form after cconv.
                ((eq fn 'internal-make-closure) form)
                ((eq (car-safe fn) 'lambda)
                (let ((newform (byte-compile-unfold-lambda form)))
                (if (eq newform form)
                ;; Some error occurred, avoid infinite recursion
                form
                (byte-optimize-form newform for-effect))))
                ((eq (car-safe fn) 'closure) form)
                ((byte-code-function-p fn)
                (cons fn (mapcar #'byte-optimize-form (cdr form))))
                ((not (symbolp fn))
                (byte-compile-warn "`%s' is a malformed function"
                (prin1-to-string fn))
                form)
                ((and for-effect (setq tmp (get fn 'side-effect-free))
                (or byte-compile-delete-errors
                (eq tmp 'error-free)
                (progn
                (byte-compile-warn "value returned from %s is unused"
                (prin1-to-string form))
                nil)))
                (byte-compile-log " %s called for effect; deleted" fn)
                ;; appending a nil here might not be necessary, but it can't hurt.
                (byte-optimize-form
                (cons 'progn (append (cdr form) '(nil))) t))
                (if (symbolp binding)
                binding
                (if (cdr (cdr binding))
                (byte-compile-warn "malformed let binding: `%s'"
                (prin1-to-string binding)))
                (list (car binding)
                (byte-optimize-form (nth 1 binding) nil))))
                bindings)
                (byte-optimize-body exps for-effect))))
                (`(cond . ,clauses)
                (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)))
                (`(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))
                (if exps
                `(prog1 ,(byte-optimize-form exp for-effect)
                . ,(byte-optimize-body exps t))
                (byte-optimize-form exp for-effect)))
                (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
                ;; Those subrs which have an implicit progn; it's not quite good
                ;; enough to treat these like normal function calls.
                ;; This can turn (save-excursion ...) into (save-excursion) which
                ;; will be optimized away in the lap-optimize pass.
                (cons fn (byte-optimize-body exps for-effect)))
                (`(if ,test ,then . ,else)
                `(if ,(byte-optimize-form test nil)
                ,(byte-optimize-form then for-effect)
                . ,(byte-optimize-body else for-effect)))
                (`(if . ,_)
                (byte-compile-warn "too few arguments for `if'"))
                (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
                ;; Take forms off the back until we can't any more.
                ;; In the future it could conceivably be a problem that the
                ;; subexpressions of these forms are optimized in the reverse
                ;; order, but it's ok for now.
                (if for-effect
                (let ((backwards (reverse exps)))
                (while (and backwards
                (null (setcar backwards
                (byte-optimize-form (car backwards)
                for-effect))))
                (setq backwards (cdr backwards)))
                (if (and exps (null backwards))
                (byte-compile-log
                " all subforms of %s called for effect; deleted" form))
                (and backwards
                (cons fn (nreverse (mapcar #'byte-optimize-form
                backwards)))))
                (cons fn (mapcar #'byte-optimize-form exps))))
                (`(while ,exp . ,exps)
                `(while ,(byte-optimize-form exp nil)
                . ,(byte-optimize-body exps t)))
                (`(while . ,_)
                (byte-compile-warn "too few arguments for `while'"))
                (`(interactive . ,_)
                (byte-compile-warn "misplaced interactive spec: `%s'"
                (prin1-to-string form))
                nil)
                (`(function . ,_)
                ;; This forms is compiled as constant or by breaking out
                ;; all the subexpressions and compiling them separately.
                form)
                (t
                ;; Otherwise, no args can be considered to be for-effect,
                ;; even if the called function is for-effect, because we
                ;; don't know anything about that function.
                (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
                (if (get fn 'pure)
                (byte-optimize-constant-args form)
                form))))))
                (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
                `(condition-case ,var ;Not evaluated.
                ,(byte-optimize-form exp for-effect)
                ,@(mapcar (lambda (clause)
                `(,(car clause)
                ,@(byte-optimize-body (cdr clause) for-effect)))
                clauses)))
                (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare))
                ;; The "protected" part of an unwind-protect is compiled (and thus
                ;; optimized) as a top-level form, so don't do it here. But the
                ;; non-protected part has the same for-effect status as the
                ;; unwind-protect itself. (The protected part is always for effect,
                ;; but that isn't handled properly yet.)
                `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps))
                (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
                `(catch ,(byte-optimize-form tag nil)
                . ,(byte-optimize-body exps for-effect)))
                (`(ignore . ,exps)
                ;; Don't treat the args to `ignore' as being
                ;; computed for effect. We want to avoid the warnings
                ;; that might occur if they were treated that way.
                ;; However, don't actually bother calling `ignore'.
                `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
                ;; Needed as long as we run byte-optimize-form after cconv.
                (`(internal-make-closure . ,_) form)
                (`((lambda . ,_) . ,_)
                (let ((newform (byte-compile-unfold-lambda form)))
                (if (eq newform form)
                ;; Some error occurred, avoid infinite recursion.
                form
                (byte-optimize-form newform for-effect))))
                ;; FIXME: Strictly speaking, I think this is a bug: (closure...)
                ;; is a *value* and shouldn't appear in the car.
                (`((closure . ,_) . ,_) form)
                (`(,(pred byte-code-function-p) . ,exps)
                (cons fn (mapcar #'byte-optimize-form exps)))
                (`(,(pred (not symbolp)) . ,_)
                (byte-compile-warn "`%s' is a malformed function"
                (prin1-to-string fn))
                form)
                ((guard (when for-effect
                (if-let ((tmp (get fn 'side-effect-free)))
                (or byte-compile-delete-errors
                (eq tmp 'error-free)
                (progn
                (byte-compile-warn "value returned from %s is unused"
                (prin1-to-string form))
                nil)))))
                (byte-compile-log " %s called for effect; deleted" fn)
                ;; appending a nil here might not be necessary, but it can't hurt.
                (byte-optimize-form
                (cons 'progn (append (cdr form) '(nil))) t))
                (_
                ;; Otherwise, no args can be considered to be for-effect,
                ;; even if the called function is for-effect, because we
                ;; don't know anything about that function.
                (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
                (if (get fn 'pure)
                (byte-optimize-constant-args form)
                form))))))
                (defun byte-optimize-form (form &optional for-effect)
                "The source-level pass of the optimizer."
                ......
                Markdown is supported
                0% or .
                You are about to add 0 people to the discussion. Proceed with caution.
                Finish editing this message first!
                Please register or to comment