Function: math-add-objects-fancy

math-add-objects-fancy is an autoloaded and byte-compiled function defined in calc-arith.el.gz.

Signature

(math-add-objects-fancy A B)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
(defun math-add-objects-fancy (a b)
  (cond ((and (Math-numberp a) (Math-numberp b))
	 (let ((aa (math-complex a))
	       (bb (math-complex b)))
	   (math-normalize
	    (let ((res (list 'cplx
			     (math-add (nth 1 aa) (nth 1 bb))
			     (math-add (nth 2 aa) (nth 2 bb)))))
	      (if (math-want-polar a b)
		  (math-polar res)
		res)))))
	((or (Math-vectorp a) (Math-vectorp b))
	 (math-map-vec-2 'math-add a b))
	((eq (car-safe a) 'sdev)
	 (if (eq (car-safe b) 'sdev)
	     (math-make-sdev (math-add (nth 1 a) (nth 1 b))
			     (math-hypot (nth 2 a) (nth 2 b)))
	   (and (or (Math-scalarp b)
		    (not (Math-objvecp b)))
		(math-make-sdev (math-add (nth 1 a) b) (nth 2 a)))))
	((and (eq (car-safe b) 'sdev)
	      (or (Math-scalarp a)
		  (not (Math-objvecp a))))
	 (math-make-sdev (math-add a (nth 1 b)) (nth 2 b)))
	((eq (car-safe a) 'intv)
	 (if (eq (car-safe b) 'intv)
	     (math-make-intv (logior (logand (nth 1 a) (nth 1 b))
				     (if (equal (nth 2 a)
						'(neg (var inf var-inf)))
					 (logand (nth 1 a) 2) 0)
				     (if (equal (nth 2 b)
						'(neg (var inf var-inf)))
					 (logand (nth 1 b) 2) 0)
				     (if (equal (nth 3 a) '(var inf var-inf))
					 (logand (nth 1 a) 1) 0)
				     (if (equal (nth 3 b) '(var inf var-inf))
					 (logand (nth 1 b) 1) 0))
			     (math-add (nth 2 a) (nth 2 b))
			     (math-add (nth 3 a) (nth 3 b)))
	   (and (or (Math-anglep b)
		    (eq (car b) 'date)
		    (not (Math-objvecp b)))
		(math-make-intv (nth 1 a)
				(math-add (nth 2 a) b)
				(math-add (nth 3 a) b)))))
	((and (eq (car-safe b) 'intv)
	      (or (Math-anglep a)
		  (eq (car a) 'date)
		  (not (Math-objvecp a))))
	 (math-make-intv (nth 1 b)
			 (math-add a (nth 2 b))
			 (math-add a (nth 3 b))))
	((eq (car-safe a) 'date)
	 (cond ((eq (car-safe b) 'date)
		(math-add (nth 1 a) (nth 1 b)))
	       ((eq (car-safe b) 'hms)
		(let ((parts (math-date-parts (nth 1 a))))
		  (list 'date
			(math-add (car parts)   ; this minimizes roundoff
				  (math-div (math-add
					     (math-add (nth 1 parts)
						       (nth 2 parts))
					     (math-add
					      (math-mul (nth 1 b) 3600)
					      (math-add (math-mul (nth 2 b) 60)
							(nth 3 b))))
					    86400)))))
	       ((Math-realp b)
		(list 'date (math-add (nth 1 a) b)))
	       (t nil)))
	((eq (car-safe b) 'date)
	 (math-add-objects-fancy b a))
	((and (eq (car-safe a) 'mod)
	      (eq (car-safe b) 'mod)
	      (equal (nth 2 a) (nth 2 b)))
	 (math-make-mod (math-add (nth 1 a) (nth 1 b)) (nth 2 a)))
	((and (eq (car-safe a) 'mod)
	      (Math-anglep b))
	 (math-make-mod (math-add (nth 1 a) b) (nth 2 a)))
	((and (eq (car-safe b) 'mod)
	      (Math-anglep a))
	 (math-make-mod (math-add a (nth 1 b)) (nth 2 b)))
	((and (or (eq (car-safe a) 'hms) (eq (car-safe b) 'hms))
	      (and (Math-anglep a) (Math-anglep b)))
	 (or (eq (car-safe a) 'hms) (setq a (math-to-hms a)))
	 (or (eq (car-safe b) 'hms) (setq b (math-to-hms b)))
	 (math-normalize
	  (if (math-negp a)
	      (math-neg (math-add (math-neg a) (math-neg b)))
	    (if (math-negp b)
		(let* ((s (math-add (nth 3 a) (nth 3 b)))
		       (m (math-add (nth 2 a) (nth 2 b)))
		       (h (math-add (nth 1 a) (nth 1 b))))
		  (if (math-negp s)
		      (setq s (math-add s 60)
			    m (math-add m -1)))
		  (if (math-negp m)
		      (setq m (math-add m 60)
			    h (math-add h -1)))
		  (if (math-negp h)
		      (math-add b a)
		    (list 'hms h m s)))
	      (let* ((s (math-add (nth 3 a) (nth 3 b)))
		     (m (math-add (nth 2 a) (nth 2 b)))
		     (h (math-add (nth 1 a) (nth 1 b))))
		(list 'hms h m s))))))
	(t (calc-record-why "*Incompatible arguments for +" a b))))