Function: math-mul-objects-fancy

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

Signature

(math-mul-objects-fancy A B)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
(defun math-mul-objects-fancy (a b)
  (cond ((and (Math-numberp a) (Math-numberp b))
	 (math-normalize
	  (if (math-want-polar a b)
	      (let ((a (math-polar a))
		    (b (math-polar b)))
		(list 'polar
		      (math-mul (nth 1 a) (nth 1 b))
		      (math-fix-circular (math-add (nth 2 a) (nth 2 b)))))
	    (setq a (math-complex a)
		  b (math-complex b))
	    (list 'cplx
		  (math-sub (math-mul (nth 1 a) (nth 1 b))
			    (math-mul (nth 2 a) (nth 2 b)))
		  (math-add (math-mul (nth 1 a) (nth 2 b))
			    (math-mul (nth 2 a) (nth 1 b)))))))
	((Math-vectorp a)
	 (if (Math-vectorp b)
	     (if (math-matrixp a)
		 (if (math-matrixp b)
		     (if (= (length (nth 1 a)) (length b))
			 (math-mul-mats a b)
		       (math-dimension-error))
		   (if (= (length (nth 1 a)) 2)
		       (if (= (length a) (length b))
			   (math-mul-mats a (list 'vec b))
			 (math-dimension-error))
		     (if (= (length (nth 1 a)) (length b))
			 (math-mul-mat-vec a b)
		       (math-dimension-error))))
	       (if (math-matrixp b)
		   (if (= (length a) (length b))
		       (nth 1 (math-mul-mats (list 'vec a) b))
		     (math-dimension-error))
		 (if (= (length a) (length b))
		     (math-dot-product a b)
		   (math-dimension-error))))
	   (math-map-vec-2 'math-mul a b)))
	((Math-vectorp b)
	 (math-map-vec-2 'math-mul a b))
	((eq (car-safe a) 'sdev)
	 (if (eq (car-safe b) 'sdev)
	     (math-make-sdev (math-mul (nth 1 a) (nth 1 b))
			     (math-hypot (math-mul (nth 2 a) (nth 1 b))
					 (math-mul (nth 2 b) (nth 1 a))))
	   (and (or (Math-scalarp b)
		    (not (Math-objvecp b)))
		(math-make-sdev (math-mul (nth 1 a) b)
				(math-mul (nth 2 a) b)))))
	((and (eq (car-safe b) 'sdev)
	      (or (Math-scalarp a)
		  (not (Math-objvecp a))))
	 (math-make-sdev (math-mul a (nth 1 b)) (math-mul a (nth 2 b))))
	((and (eq (car-safe a) 'intv) (Math-anglep b))
	 (if (Math-negp b)
	     (math-neg (math-mul a (math-neg b)))
	   (math-make-intv (nth 1 a)
			   (math-mul (nth 2 a) b)
			   (math-mul (nth 3 a) b))))
	((and (eq (car-safe b) 'intv) (Math-anglep a))
	 (math-mul b a))
	((and (eq (car-safe a) 'intv) (math-intv-constp a)
	      (eq (car-safe b) 'intv) (math-intv-constp b))
	 (let ((lo (math-mul a (nth 2 b)))
	       (hi (math-mul a (nth 3 b))))
	   (or (eq (car-safe lo) 'intv)
	       (setq lo (list 'intv (if (memq (nth 1 b) '(2 3)) 3 0) lo lo)))
	   (or (eq (car-safe hi) 'intv)
	       (setq hi (list 'intv (if (memq (nth 1 b) '(1 3)) 3 0) hi hi)))
	   (math-combine-intervals
	    (nth 2 lo) (and (or (memq (nth 1 b) '(2 3))
				(math-infinitep (nth 2 lo)))
			    (memq (nth 1 lo) '(2 3)))
	    (nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
				(math-infinitep (nth 3 lo)))
			    (memq (nth 1 lo) '(1 3)))
	    (nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
				(math-infinitep (nth 2 hi)))
			    (memq (nth 1 hi) '(2 3)))
	    (nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
				(math-infinitep (nth 3 hi)))
			    (memq (nth 1 hi) '(1 3))))))
	((and (eq (car-safe a) 'mod)
	      (eq (car-safe b) 'mod)
	      (equal (nth 2 a) (nth 2 b)))
	 (math-make-mod (math-mul (nth 1 a) (nth 1 b)) (nth 2 a)))
	((and (eq (car-safe a) 'mod)
	      (Math-anglep b))
	 (math-make-mod (math-mul (nth 1 a) b) (nth 2 a)))
	((and (eq (car-safe b) 'mod)
	      (Math-anglep a))
	 (math-make-mod (math-mul a (nth 1 b)) (nth 2 b)))
	((and (eq (car-safe a) 'hms) (Math-realp b))
	 (math-with-extra-prec 2
	   (math-to-hms (math-mul (math-from-hms a 'deg) b) 'deg)))
	((and (eq (car-safe b) 'hms) (Math-realp a))
	 (math-mul b a))
	(t (calc-record-why "*Incompatible arguments for *" a b))))