Function: comp-cstr-intersection-homogeneous

comp-cstr-intersection-homogeneous is a byte-compiled function defined in comp-cstr.el.gz.

Signature

(comp-cstr-intersection-homogeneous DST &rest SRCS)

Documentation

Combine SRCS by intersection set operation setting the result in DST.

All SRCS constraints must be homogeneously negated or non-negated. DST is returned.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp-cstr.el.gz
(cl-defun comp-cstr-intersection-homogeneous (dst &rest srcs)
  "Combine SRCS by intersection set operation setting the result in DST.
All SRCS constraints must be homogeneously negated or non-negated.
DST is returned."

  (with-comp-cstr-accessors
    (when (cl-some #'comp-cstr-empty-p srcs)
      (setf (valset dst) nil
            (range dst) nil
            (typeset dst) nil)
      (cl-return-from comp-cstr-intersection-homogeneous dst))

    (setf (neg dst) (when srcs
                      (neg (car srcs))))

    ;; Type propagation.
    (setf (typeset dst)
          (apply #'comp--intersect-typesets
                 (mapcar #'comp-cstr-typeset srcs)))

    ;; Value propagation.
    (setf (valset dst)
          (comp--normalize-valset
           (cl-loop
            for src in srcs
            append
            (cl-loop
             for val in (valset src)
             ;; If (member value) is subtypep of all other sources then
             ;; is good to be collected.
             when (cl-every (lambda (s)
                              (or (memql val (valset s))
                                  (cl-some (lambda (type)
                                             (cl-typep val type))
                                           (typeset s))))
                            (remq src srcs))
             collect val))))

    ;; Range propagation.
    (setf (range dst)
          ;; Do range propagation only if the destination typeset
          ;; doesn't cover it already.
          (unless (cl-some (lambda (type)
                             (comp-subtype-p 'integer type))
                           (typeset dst))
            (apply #'comp--range-intersection
                   (cl-loop
                    for src in srcs
                    ;; Collect effective ranges.
                    collect (or (range src)
                                (when (cl-some (lambda (s)
                                                 (comp-subtype-p 'integer s))
                                               (typeset src))
                                  '((- . +))))))))

    dst))