Function: math-simplify-units-prod

math-simplify-units-prod is a byte-compiled function defined in calc-units.el.gz.

Signature

(math-simplify-units-prod EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-units.el.gz
(defun math-simplify-units-prod (expr)
  (and math-simplifying-units
       calc-autorange-units
       (Math-realp (nth 1 expr))
       (let* ((num (math-float (nth 1 expr)))
	      (xpon (calcFunc-xpon num))
	      (unitp (cdr (cdr expr)))
	      (unit (car unitp))
	      (pow (if (eq (car expr) '*) 1 -1))
	      u)
	 (and (eq (car-safe unit) '*)
	      (setq unitp (cdr unit)
		    unit (car unitp)))
	 (and (eq (car-safe unit) '^)
	      (integerp (nth 2 unit))
	      (setq pow (* pow (nth 2 unit))
		    unitp (cdr unit)
		    unit (car unitp)))
	 (and (setq u (math-check-unit-name unit))
	      (integerp xpon)
	      (or (< xpon 0)
		  (>= xpon (if (eq (car u) 'm) 1 3)))
	      (let* ((uxpon 0)
		     (pref (if (< pow 0)
			       (reverse math-unit-prefixes)
			     math-unit-prefixes))
		     (p pref)
		     pxpon pname)
		(or (eq (car u) (nth 1 unit))
		    (setq uxpon (* pow
				   (nth 2 (nth 1 (assq
						  (aref (symbol-name
							 (nth 1 unit)) 0)
						  math-unit-prefixes))))))
		(setq xpon (+ xpon uxpon))
		(while (and p
			    (or (memq (car (car p)) '(?d ?D ?h ?H))
				(and (eq (car (car p)) ?c)
				     (not (eq (car u) 'm)))
				(< xpon (setq pxpon (* (nth 2 (nth 1 (car p)))
						       pow)))
				(progn
				  (setq pname (math-build-var-name
					       (if (eq (car (car p)) 0)
						   (car u)
						 (concat (char-to-string
							  (car (car p)))
							 (symbol-name
							  (car u))))))
				  (and (/= (car (car p)) 0)
				       (assq (nth 1 pname)
					     math-units-table)))))
		  (setq p (cdr p)))
		(and p
		     (/= pxpon uxpon)
		     (or (not (eq p pref))
			 (< xpon (+ pxpon (* (math-abs pow) 3))))
		     (progn
		       (setcar (cdr expr)
			       (let ((calc-prefer-frac nil))
				 (calcFunc-scf (nth 1 expr)
					       (- uxpon pxpon))))
		       (setcar unitp pname)
		       expr)))))))