Function: math-possible-signs
math-possible-signs is an autoloaded and byte-compiled function
defined in calc-arith.el.gz.
Signature
(math-possible-signs A &optional ORIGIN)
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
;;; Find the possible signs of A, assuming A is a number of some kind.
;;; Returns an integer with bits: 1 may be negative,
;;; 2 may be zero,
;;; 4 may be positive,
;;; 8 may be nonreal.
(defun math-possible-signs (a &optional origin)
(cond ((Math-objectp a)
(if origin (setq a (math-sub a origin)))
(cond ((Math-posp a) 4)
((Math-negp a) 1)
((Math-zerop a) 2)
((eq (car a) 'intv)
(cond
((math-known-posp (nth 2 a)) 4)
((math-known-negp (nth 3 a)) 1)
((Math-zerop (nth 2 a)) 6)
((Math-zerop (nth 3 a)) 3)
(t 7)))
((eq (car a) 'sdev)
(if (math-known-realp (nth 1 a)) 7 15))
(t 8)))
((memq (car a) '(+ -))
(cond ((Math-realp (nth 1 a))
(if (eq (car a) '-)
(math-neg-signs
(math-possible-signs (nth 2 a)
(if origin
(math-add origin (nth 1 a))
(nth 1 a))))
(math-possible-signs (nth 2 a)
(if origin
(math-sub origin (nth 1 a))
(math-neg (nth 1 a))))))
((Math-realp (nth 2 a))
(let ((org (if (eq (car a) '-)
(nth 2 a)
(math-neg (nth 2 a)))))
(math-possible-signs (nth 1 a)
(if origin
(math-add origin org)
org))))
(t
(let ((s1 (math-possible-signs (nth 1 a) origin))
(s2 (math-possible-signs (nth 2 a))))
(if (eq (car a) '-) (setq s2 (math-neg-signs s2)))
(cond ((eq s1 s2) s1)
((eq s1 2) s2)
((eq s2 2) s1)
((>= s1 8) 15)
((>= s2 8) 15)
((and (eq s1 4) (eq s2 6)) 4)
((and (eq s2 4) (eq s1 6)) 4)
((and (eq s1 1) (eq s2 3)) 1)
((and (eq s2 1) (eq s1 3)) 1)
(t 7))))))
((eq (car a) 'neg)
(math-neg-signs (math-possible-signs
(nth 1 a)
(and origin (math-neg origin)))))
((and origin (Math-zerop origin) (setq origin nil)
nil))
((and (or (eq (car a) '*)
(and (eq (car a) '/) origin))
(Math-realp (nth 1 a)))
(let ((s (if (eq (car a) '*)
(if (Math-zerop (nth 1 a))
(math-possible-signs 0 origin)
(math-possible-signs (nth 2 a)
(math-div (or origin 0)
(nth 1 a))))
(math-neg-signs
(math-possible-signs (nth 2 a)
(math-div (nth 1 a)
origin))))))
(if (Math-negp (nth 1 a)) (math-neg-signs s) s)))
((and (memq (car a) '(* /)) (Math-realp (nth 2 a)))
(let ((s (math-possible-signs (nth 1 a)
(if (eq (car a) '*)
(math-mul (or origin 0) (nth 2 a))
(math-div (or origin 0) (nth 2 a))))))
(if (Math-negp (nth 2 a)) (math-neg-signs s) s)))
((eq (car a) 'vec)
(let ((signs 0))
(while (and (setq a (cdr a)) (< signs 15))
(setq signs (logior signs (math-possible-signs
(car a) origin))))
signs))
(t (let ((sign
(cond
((memq (car a) '(* /))
(let ((s1 (math-possible-signs (nth 1 a)))
(s2 (math-possible-signs (nth 2 a))))
(cond ((>= s1 8) 15)
((>= s2 8) 15)
((and (eq (car a) '/) (memq s2 '(2 3 6 7))) 15)
(t
(logior (if (memq s1 '(4 5 6 7)) s2 0)
(if (memq s1 '(2 3 6 7)) 2 0)
(if (memq s1 '(1 3 5 7))
(math-neg-signs s2) 0))))))
((eq (car a) '^)
(let ((s1 (math-possible-signs (nth 1 a)))
(s2 (math-possible-signs (nth 2 a))))
(cond ((>= s1 8) 15)
((>= s2 8) 15)
((eq s1 4) 4)
((eq s1 2) (if (eq s2 4) 2 15))
((eq s2 2) (if (memq s1 '(1 5)) 2 15))
((Math-integerp (nth 2 a))
(if (math-evenp (nth 2 a))
(if (memq s1 '(3 6 7)) 6 4)
s1))
((eq s1 6) (if (eq s2 4) 6 15))
(t 7))))
((eq (car a) '%)
(let ((s2 (math-possible-signs (nth 2 a))))
(cond ((>= s2 8) 7)
((eq s2 2) 2)
((memq s2 '(4 6)) 6)
((memq s2 '(1 3)) 3)
(t 7))))
((and (memq (car a) '(calcFunc-abs calcFunc-abssqr))
(= (length a) 2))
(let ((s1 (math-possible-signs (nth 1 a))))
(cond ((eq s1 2) 2)
((memq s1 '(1 4 5)) 4)
(t 6))))
((and (eq (car a) 'calcFunc-exp) (= (length a) 2))
(let ((s1 (math-possible-signs (nth 1 a))))
(if (>= s1 8)
15
(if (or (not origin) (math-negp origin))
4
(setq origin (math-sub (or origin 0) 1))
(if (Math-zerop origin) (setq origin nil))
s1))))
((or (and (memq (car a) '(calcFunc-ln calcFunc-log10))
(= (length a) 2))
(and (eq (car a) 'calcFunc-log)
(= (length a) 3)
(math-known-posp (nth 2 a))))
(if (math-known-nonnegp (nth 1 a))
(math-possible-signs (nth 1 a) 1)
15))
((and (eq (car a) 'calcFunc-sqrt) (= (length a) 2))
(let ((s1 (math-possible-signs (nth 1 a))))
(if (memq s1 '(2 4 6)) s1 15)))
((memq (car a) math-nonnegative-functions) 6)
((memq (car a) math-positive-functions) 4)
((memq (car a) math-real-functions) 7)
((memq (car a) math-real-scalar-functions) 7)
((and (memq (car a) math-real-if-arg-functions)
(= (length a) 2))
(if (math-known-realp (nth 1 a)) 7 15)))))
(cond (sign
(if origin
(+ (logand sign 8)
(if (Math-posp origin)
(if (memq sign '(1 2 3 8 9 10 11)) 1 7)
(if (memq sign '(2 4 6 8 10 12 14)) 4 7)))
sign))
((math-const-var a)
(cond ((eq (nth 2 a) 'var-pi)
(if origin
(math-possible-signs (math-pi) origin)
4))
((eq (nth 2 a) 'var-e)
(if origin
(math-possible-signs (math-e) origin)
4))
((eq (nth 2 a) 'var-inf) 4)
((eq (nth 2 a) 'var-uinf) 13)
((eq (nth 2 a) 'var-i) 8)
(t 15)))
(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))))
(if (and origin
(memq 'int (nth 1 decl))
(not (Math-num-integerp origin)))
5
(if (nth 2 decl)
(math-possible-signs (nth 2 decl) origin)
(if (memq 'real (nth 1 decl))
7
15))))))))))