Function: math-prepare-set

math-prepare-set is an autoloaded and byte-compiled function defined in calc-vec.el.gz.

Signature

(math-prepare-set A)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-vec.el.gz
(defun math-prepare-set (a)
  (if (Math-objectp a)
      (setq a (list 'vec a))
    (or (math-vectorp a) (math-reject-arg a 'vectorp))
    (setq a (cons 'vec (sort (copy-sequence (cdr a)) 'math-beforep))))
  (let ((p a) res)

    ;; Convert all elements to non-empty intervals.
    (while (cdr p)
      (if (eq (car-safe (nth 1 p)) 'intv)
	  (if (math-intv-constp (nth 1 p))
	      (if (and (memq (nth 1 (nth 1 p)) '(0 1 2))
		       (Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
		  (setcdr p (cdr (cdr p)))
		(setq p (cdr p)))
	    (math-reject-arg (nth 1 p) 'constp))
	(or (Math-anglep (nth 1 p))
	    (eq (car (nth 1 p)) 'date)
	    (equal (nth 1 p) '(var inf var-inf))
	    (equal (nth 1 p) '(neg (var inf var-inf)))
	    (math-reject-arg (nth 1 p) 'realp))
	(setcar (cdr p) (list 'intv 3 (nth 1 p) (nth 1 p)))
	(setq p (cdr p))))

    ;; Combine redundant intervals.
    (setq p a)
    (while (cdr (cdr p))
      (if (or (memq (setq res (math-compare (nth 3 (nth 1 p))
					    (nth 2 (nth 2 p))))
		    '(-1 2))
	      (and (eq res 0)
		   (memq (nth 1 (nth 1 p)) '(0 2))
		   (memq (nth 1 (nth 2 p)) '(0 1))))
	  (setq p (cdr p))
	(setq res (math-compare (nth 3 (nth 1 p)) (nth 3 (nth 2 p))))
	(setcdr p (cons (list 'intv
			      (+ (logand (logior (nth 1 (nth 1 p))
						 (if (Math-equal
						      (nth 2 (nth 1 p))
						      (nth 2 (nth 2 p)))
						     (nth 1 (nth 2 p))
						   0))
					 2)
				 (logand (logior (if (memq res '(1 0 2))
						     (nth 1 (nth 1 p)) 0)
						 (if (memq res '(-1 0 2))
						     (nth 1 (nth 2 p)) 0))
					 1))
			      (nth 2 (nth 1 p))
			      (if (eq res 1)
				  (nth 3 (nth 1 p))
				(nth 3 (nth 2 p))))
			(cdr (cdr (cdr p))))))))
  a)