Function: comp--type-check-optim-block

comp--type-check-optim-block is a byte-compiled function defined in comp.el.gz.

Signature

(comp--type-check-optim-block BLOCK)

Documentation

Optimize conditional branches in BLOCK when possible.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp.el.gz
;;; Type check optimizer pass specific code.

;; This pass optimize-out unnecessary type checks, that is calls to
;; `type-of' and corresponding conditional branches.
;;
;; This is often advantageous in cases where a function manipulates an
;; object with several slot accesses like:
;;
;; (cl-defstruct foo a b c)
;; (defun bar (x)
;;   (setf (foo-a x) 3)
;;   (+ (foo-b x) (foo-c x)))
;;
;; After x is accessed and type checked once, it's proved to be of type
;; foo, and no other type checks are required.

;; At present running this pass over the whole Emacs codebase triggers
;; the optimization of 1972 type checks.

(defun comp--type-check-optim-block (block)
  "Optimize conditional branches in BLOCK when possible."
  (cl-loop
   named in-the-basic-block
   for insns-seq on (comp-block-insns block)
   do (pcase insns-seq
        (`((set ,(and (pred comp-mvar-p) mvar-tested-copy)
                ,(and (pred comp-mvar-p) mvar-tested))
           (set ,(and (pred comp-mvar-p) mvar-1)
                (call type-of ,(and (pred comp-mvar-p) mvar-tested-copy)))
           (set ,(and (pred comp-mvar-p) mvar-2)
                (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
           (set ,(and (pred comp-mvar-p) mvar-3)
                (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2)))
           (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2))
         (cl-assert (comp-cstr-imm-vld-p mvar-tag))
         (when (comp-cstr-type-p mvar-tested (comp-cstr-cl-tag mvar-tag))
           (comp-log (format "Optimizing conditional branch %s in function: %s"
                             bb1
                             (comp-func-name comp-func))
                     3)
           (setf (car insns-seq) '(comment "optimized by comp--type-check-optim")
                 (cdr insns-seq) `((jump ,bb2))
                 ;; Set the SSA status as dirty so
                 ;; `comp--ssa-function' will remove the unreachable
                 ;; branches later.
                 (comp-func-ssa-status comp-func) 'dirty))))))