Function: math-possible-types

math-possible-types is an autoloaded and byte-compiled function defined in calc-arith.el.gz.

Signature

(math-possible-types A &optional NUM)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
;;; Find the possible types of A.
;;; Returns an integer with bits:  1  may be integer.
;;;				   2  may be integer-valued float.
;;;				   4  may be fraction.
;;;				   8  may be non-integer-valued float.
;;;				  16  may be imaginary.
;;;				  32  may be non-real, non-imaginary.
;;; Real infinities count as integers for the purposes of this function.
(defun math-possible-types (a &optional num)
  (cond ((Math-objectp a)
	 (cond ((Math-integerp a) (if num 3 1))
	       ((Math-messy-integerp a) (if num 3 2))
	       ((eq (car a) 'frac) (if num 12 4))
	       ((eq (car a) 'float) (if num 12 8))
	       ((eq (car a) 'intv)
		(if (equal (nth 2 a) (nth 3 a))
		    (math-possible-types (nth 2 a))
		  15))
	       ((eq (car a) 'sdev)
		(if (math-known-realp (nth 1 a)) 15 63))
	       ((eq (car a) 'cplx)
		(if (math-zerop (nth 1 a)) 16 32))
	       ((eq (car a) 'polar)
		(if (or (Math-equal (nth 2 a) (math-quarter-circle nil))
			(Math-equal (nth 2 a)
				    (math-neg (math-quarter-circle nil))))
		    16 48))
	       (t 63)))
	((eq (car a) '/)
	 (let* ((t1 (math-possible-types (nth 1 a) num))
		(t2 (math-possible-types (nth 2 a) num))
		(t12 (logior t1 t2)))
	   (if (< t12 16)
	       (if (> (logand t12 10) 0)
		   10
		 (if (or (= t1 4) (= t2 4) calc-prefer-frac)
		     5
		   15))
	     (if (< t12 32)
		 (if (= t1 16)
		     (if (= t2 16) 15
		       (if (< t2 16) 16 31))
		   (if (= t2 16)
		       (if (< t1 16) 16 31)
		     31))
	       63))))
	((memq (car a) '(+ - * %))
	 (let* ((t1 (math-possible-types (nth 1 a) num))
		(t2 (math-possible-types (nth 2 a) num))
		(t12 (logior t1 t2)))
	   (if (eq (car a) '%)
	       (setq t1 (logand t1 15) t2 (logand t2 15) t12 (logand t12 15)))
	   (if (< t12 16)
	       (let ((mask (if (<= t12 3)
			       1
			     (if (and (or (and (<= t1 3) (= (logand t2 3) 0))
					  (and (<= t2 3) (= (logand t1 3) 0)))
				      (memq (car a) '(+ -)))
				 4
			       5))))
		 (if num
		     (* mask 3)
		   (logior (if (and (> (logand t1 5) 0) (> (logand t2 5) 0))
			       mask 0)
			   (if (> (logand t12 10) 0)
			       (* mask 2) 0))))
	     (if (< t12 32)
		 (if (eq (car a) '*)
		     (if (= t1 16)
			 (if (= t2 16) 15
			   (if (< t2 16) 16 31))
		       (if (= t2 16)
			   (if (< t1 16) 16 31)
			 31))
		   (if (= t12 16) 16
		     (if (or (and (= t1 16) (< t2 16))
			     (and (= t2 16) (< t1 16))) 32 63)))
	       63))))
	((eq (car a) 'neg)
	 (math-possible-types (nth 1 a)))
	((eq (car a) '^)
	 (let* ((t1 (math-possible-types (nth 1 a) num))
		(t2 (math-possible-types (nth 2 a) num))
		(t12 (logior t1 t2)))
	   (if (and (<= t2 3) (math-known-nonnegp (nth 2 a)) (< t1 16))
	       (let ((mask (logior (if (> (logand t1 3) 0) 1 0)
				   (logand t1 4)
				   (if (> (logand t1 12) 0) 5 0))))
		 (if num
		     (* mask 3)
		   (logior (if (and (> (logand t1 5) 0) (> (logand t2 5) 0))
			       mask 0)
			   (if (> (logand t12 10) 0)
			       (* mask 2) 0))))
	     (if (and (math-known-nonnegp (nth 1 a))
		      (math-known-posp (nth 2 a)))
		 15
	       63))))
	((eq (car a) 'calcFunc-sqrt)
	 (let ((t1 (math-possible-signs (nth 1 a))))
	   (logior (if (> (logand t1 2) 0) 3 0)
		   (if (> (logand t1 1) 0) 16 0)
		   (if (> (logand t1 4) 0) 15 0)
		   (if (> (logand t1 8) 0) 32 0))))
	((eq (car a) 'vec)
	 (let ((types 0))
	   (while (and (setq a (cdr a)) (< types 63))
	     (setq types (logior types (math-possible-types (car a) t))))
	   types))
	((or (memq (car a) math-integer-functions)
	     (and (memq (car a) math-rounding-functions)
		  (math-known-nonnegp (or (nth 2 a) 0))))
	 1)
	((or (memq (car a) math-num-integer-functions)
	     (and (memq (car a) math-float-rounding-functions)
		  (math-known-nonnegp (or (nth 2 a) 0))))
	 2)
	((eq (car a) 'calcFunc-frac)
	 5)
	((and (eq (car a) 'calcFunc-float) (= (length a) 2))
	 (let ((t1 (math-possible-types (nth 1 a))))
	   (logior (if (> (logand t1 3) 0) 2 0)
		   (if (> (logand t1 12) 0) 8 0)
		   (logand t1 48))))
	((and (memq (car a) '(calcFunc-abs calcFunc-abssqr))
	      (= (length a) 2))
	 (let ((t1 (math-possible-types (nth 1 a))))
	   (if (>= t1 16)
	       15
	     t1)))
	((math-const-var a)
	 (cond ((memq (nth 2 a) '(var-e var-pi var-phi var-gamma)) 8)
	       ((eq (nth 2 a) 'var-inf) 1)
	       ((eq (nth 2 a) 'var-i) 16)
	       (t 63)))
	(t
	 (math-setup-declarations)
	 (let ((decl (if (eq (car a) 'var)
			 (or (assq (nth 2 a) math-decls-cache)
			     math-decls-all)
		       (assq (car a) math-decls-cache))))
	   (cond ((memq 'int (nth 1 decl))
		  1)
		 ((memq 'numint (nth 1 decl))
		  3)
		 ((memq 'frac (nth 1 decl))
		  4)
		 ((memq 'rat (nth 1 decl))
		  5)
		 ((memq 'float (nth 1 decl))
		  10)
		 ((nth 2 decl)
		  (math-possible-types (nth 2 decl)))
		 ((memq 'real (nth 1 decl))
		  15)
		 (t 63))))))