Function: comp-add-cond-cstrs

comp-add-cond-cstrs is a byte-compiled function defined in comp.el.gz.

Signature

(comp-add-cond-cstrs)

Documentation

comp-add-cstrs worker function for each selected function.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp.el.gz
(defun comp-add-cond-cstrs ()
  "`comp-add-cstrs' worker function for each selected function."
  (cl-loop
   for b being each hash-value of (comp-func-blocks comp-func)
   do
   (cl-loop
    named in-the-basic-block
    with prev-insns-seq
    for insns-seq on (comp-block-insns b)
    do
    (pcase insns-seq
      (`((set ,(and (pred comp-mvar-p) cmp-res)
              (,(pred comp-call-op-p)
               ,(and (or (pred comp-equality-fun-p)
                         (pred comp-arithm-cmp-fun-p))
                     fun)
               ,op1 ,op2))
	 ;; (comment ,_comment-str)
	 (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
       (cl-loop
        with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b)
        with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b)
        for branch-target-cell on blocks
        for branch-target = (car branch-target-cell)
        for negated in '(t nil)
        for kind = (cl-case fun
                     (equal 'and-nhc)
                     (eql 'and-nhc)
                     (eq 'and)
                     (t fun))
        when (or (comp-mvar-used-p target-mvar1)
                 (comp-mvar-used-p target-mvar2))
        do
        (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
          (setf (car branch-target-cell) (comp-block-name block-target))
          (when (comp-mvar-used-p target-mvar1)
            (comp-emit-assume kind target-mvar1
                              (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq)
                              block-target negated))
          (when (comp-mvar-used-p target-mvar2)
            (comp-emit-assume (comp-reverse-arithm-fun kind)
                              target-mvar2
                              (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq)
                              block-target negated)))
        finally (cl-return-from in-the-basic-block)))
      (`((set ,(and (pred comp-mvar-p) cmp-res)
              (,(pred comp-call-op-p)
               ,(and (pred comp-known-predicate-p) fun)
               ,op))
	 ;; (comment ,_comment-str)
	 (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
       (cl-loop
        with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
        with cstr = (comp-pred-to-cstr fun)
        for branch-target-cell on blocks
        for branch-target = (car branch-target-cell)
        for negated in '(t nil)
        when (comp-mvar-used-p target-mvar)
        do
        (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
          (setf (car branch-target-cell) (comp-block-name block-target))
          (comp-emit-assume 'and target-mvar cstr block-target negated))
        finally (cl-return-from in-the-basic-block)))
      ;; Match predicate on the negated branch (unless).
      (`((set ,(and (pred comp-mvar-p) cmp-res)
              (,(pred comp-call-op-p)
               ,(and (pred comp-known-predicate-p) fun)
               ,op))
         (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p)))
	 (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
       (cl-loop
        with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
        with cstr = (comp-pred-to-cstr fun)
        for branch-target-cell on blocks
        for branch-target = (car branch-target-cell)
        for negated in '(nil t)
        when (comp-mvar-used-p target-mvar)
        do
        (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
          (setf (car branch-target-cell) (comp-block-name block-target))
          (comp-emit-assume 'and target-mvar cstr block-target negated))
        finally (cl-return-from in-the-basic-block))))
    (setf prev-insns-seq insns-seq))))