;;;***************************************************************
;;;An ACL2 Library of Floating Point Arithmetic

;;;David M. Russinoff
;;;Advanced Micro Devices, Inc.
;;;February, 1998
;;;***************************************************************

(in-package "ACL2")

(include-book "basic")

(defun expo1 (x)
  (declare (xargs :measure (point-right-measure x)))
  (if (and (rationalp x) (< 0 x) (< x 1))
      (1- (expo1 (* x 2)))
    0))

(defun expo2 (x)
  (declare (xargs :measure (point-left-measure x)))
  (if (and (rationalp x) (>= x 2))
      (1+ (expo2 (/ x 2)))
    0))

(defun expo (x)
  (cond ((not (rationalp x)) 0)
	((>= (abs x) 1) (expo2 (abs x)))
	(t (expo1 (abs x)))))

(defun sgn (x) 
  (if (= x 0)
      0
    (if (< x 0) -1 +1)))

(defun sig (x)
  (if (rationalp x)
      (if (< x 0)
          (- (* x (expt 2 (- (expo x)))))
        (* x (expt 2 (- (expo x)))))
    0))

(defthm fp-rep
    (implies (rationalp x)
	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
  :rule-classes ())

(defthm rationalp-sig
    (implies (rationalp x)
	     (rationalp (sig x))))

(defthm fp-abs
    (implies (rationalp x)
	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
  :rule-classes ())

(defthm fp-pos
    (implies (and (rationalp x)
		  (> x 0))
	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
  :rule-classes ())

(defthm expo2-lower-bound
    (implies (and (rationalp x)
		  (>= x 1))
	     (<= (expt 2 (expo2 x)) x))
  :rule-classes ())

(defthm expo2-upper-bound
    (implies (and (rationalp x)
		  (>= x 1))
	     (< x (expt 2 (1+ (expo2 x)))))
  :rule-classes ())

(defthm expo1-lower-bound
    (implies (and (rationalp x)
		  (< 0 x)
		  (< x 1))
	     (<= (expt 2 (expo1 x)) x))
  :rule-classes ())

(defthm expo1-upper-bound
    (implies (and (rationalp x)
		  (< 0 x)
		  (< x 1))
	     (< x (expt 2 (1+ (expo1 x)))))
  :rule-classes ())

(defthm expo-lower-bound
    (implies (and (rationalp x)
		  (not (= x 0)))
	     (<= (expt 2 (expo x)) (abs x)))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo1-lower-bound (x (abs x)))
			(:instance expo2-lower-bound (x (abs x)))))))

(defthm expo-upper-bound
    (implies (and (rationalp x)
		  (not (= x 0)))
	     (< (abs x) (expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo1-upper-bound (x (abs x)))
			(:instance expo2-upper-bound (x (abs x)))))))

(defthm sig-lower-bound
    (implies (and (rationalp x)
		  (not (= x 0)))
	     (<= 1 (sig x)))
  :rule-classes ()
  :hints (("Goal" :in-theory  (disable sig expo abs)
		  :use ((:instance fp-abs)
			(:instance expo-lower-bound)))))

(defthm sig-upper-bound
    (implies (and (rationalp x)
		  (not (= x 0)))
	     (< (sig x) 2))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable sig abs)
		  :use ((:instance fp-abs)
			(:instance expo-upper-bound)))))

(defthm sgn+-1
    (implies (and (rationalp x)
		  (not (= x 0)))
	     (or (= (sgn x) 1) (= (sgn x) -1)))
  :rule-classes ())

(defthm sgn+1
    (implies (and (rationalp x)
		  (> x 0))
	     (equal (sgn x) 1))
  :rule-classes ())

(defthm sgn-1
    (implies (and (rationalp x)
		  (< x 0))
	     (equal (sgn x) -1))
  :rule-classes ())

(defthm expo-unique-1
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp n)
		  (< n (expo x)))
	     (<= (expt 2 (1+ n)) (abs x)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-lower-bound)
			(:instance expt-monotone (n (1+ n)) (m (expo x)))))))

(defthm expo-unique-2
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp n)
		  (> n (expo x)))
	     (> (expt 2 n) (abs x)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-upper-bound)
			(:instance expt-monotone (n (1+ (expo x))) (m n))))))

(defthm expo-unique
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp n)
		  (<= (expt 2 n) (abs x))
		  (< (abs x) (expt 2 (1+ n))))
	     (equal n (expo x)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-unique-1)
			(:instance expo-unique-2)))))

(defthm expo-monotone
    (implies (and (rationalp x)
		  (not (= x 0))
		  (rationalp y)
		  (<= (abs x) (abs y)))
	     (<= (expo x) (expo y)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-lower-bound)
			(:instance expo-unique-2 (n (expo x)) (x y))))))

(defthm fp-unique-1
    (implies (and (rationalp m)
		  (integerp e)
		  (<= 1 m)
		  (< 0 e))
	     (<= 2 (* m (expt 2 e))))
  :rule-classes ())

(defthm fp-unique-2
    (implies (and (rationalp m)
		  (integerp e)
		  (< m 2)
		  (< e 0))
	     (< (* m (expt 2 e)) 1))
  :rule-classes ())

(defthm fp-unique-3
    (implies (and (rationalp m)
		  (integerp e)
		  (<= 1 m)
		  (< m 2)
		  (<= 1 (* m (expt 2 e)))
		  (< (* m (expt 2 e)) 2))
	     (= e 0))
  :rule-classes ()
  :hints (("Goal" :use ((:instance fp-unique-1)
			(:instance fp-unique-2)))))

(defthm expt-
    (implies (and (integerp a)
		  (integerp b))
	     (= (/ (expt 2 a) (expt 2 b)) (expt 2 (- a b))))
  :rule-classes ())

(defthm =*
    (implies (and (rationalp x1)
		  (rationalp x2)
		  (rationalp y)
		  (not (= y 0))
		  (= x1 x2))
	     (= (* x1 y) (* x2 y)))
  :rule-classes ())

(defthm fp-unique-4
    (implies (and (rationalp m1)
		  (integerp e1)
		  (rationalp m2)
		  (integerp e2)
		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
	     (= (* m1 (expt 2 (- e1 e2))) m2))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expt- (a e1) (b e2))
			(:instance =* (x1 (* m1 (expt 2 e1))) (x2 (* m2 (expt 2 e2))) (y (expt 2 (- e2))))))))

(defthm fp-unique-5
    (implies (and (rationalp m1)
		  (integerp e1)
		  (rationalp m2)
		  (integerp e2)
		  (<= 1 m1)
		  (< m1 2)
		  (<= 1 m2)
		  (< m2 2)
		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
	     (= e1 e2))
  :rule-classes ()
  :hints (("Goal" :use ((:instance fp-unique-3 (m m1) (e (- e1 e2)))
			(:instance fp-unique-4)))))

(defthm *cancell
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp z)
		  (not (= z 0))
		  (= (* x z) (* y z)))
	     (= x y))
  :rule-classes ()
  :hints (("Goal" :use ((:instance =* (x1 (* x z)) (x2 (* y z)) (y (/ z)))))))

(defthm fp-unique-6
    (implies (and (rationalp m1)
		  (integerp e1)
		  (rationalp m2)
		  (integerp e2)
		  (<= 1 m1)
		  (< m1 2)
		  (<= 1 m2)
		  (< m2 2)
		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
	     (= m1 m2))
  :rule-classes ()
  :hints (("Goal" :use ((:instance fp-unique-5)
			(:instance cancel-equal-* (r m1) (s m2) (a (expt 2 e1)))))))

(defthm fp-rep-unique
    (implies (and (rationalp x)
		  (not (= x 0))
		  (rationalp m)
		  (<= 1 m)
		  (< m 2)
		  (integerp e)
		  (= (abs x) (* m (expt 2 e))))
	     (and (= m (sig x))
		  (= e (expo x))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable sig expt expo)
		  :use ((:instance fp-rep)
			(:instance sig-lower-bound)
			(:instance sig-upper-bound)
			(:instance fp-unique-5 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))
			(:instance fp-unique-6 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))))))

(defthm sig-expo-shift
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp n))
	     (and (= (sig (* (expt 2 n) x)) (sig x))
		  (= (expo (* (expt 2 n) x)) (+ n (expo x)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expt-pos expo)
		  :use ((:instance sgn+1)
			(:instance fp-rep)
			(:instance expt-pos (x n))
			(:instance sig-lower-bound)
			(:instance sig-upper-bound)
			(:instance fp-rep-unique (x (* (expt 2 n) x)) (m (sig x)) (e (+ n (expo x))))))))

(defthm expt-non-neg
    (implies (integerp n)
	     (not (< (expt 2 n) 0))))

(defthm expo-prod-lower
    (implies (and (rationalp x)
		  (not (= x 0))
		  (rationalp y)
		  (not (= y 0)))
	     (<= (+ (expo x) (expo y)) (expo (* x y))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo sig)
		  :use ((:instance *-doubly-monotonic 
				   (x (expt 2 (expo x)))
				   (y (abs x))
				   (a (expt 2 (expo y)))
				   (b (abs y)))
			(:instance expo-lower-bound)
			(:instance expo-lower-bound (x y))
			(:instance expo-unique-2 (x (* x y)) (n (+ (expo x) (expo y))))))))

(defthm *-doubly-strongly-monotonic
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp a)
		  (rationalp b)
		  (< 0 x)
		  (< 0 y)
		  (< 0 a)
		  (< 0 b)
		  (< x y)
		  (< a b))
	     (< (* x a) (* y b)))
  :rule-classes ())

(defthm expo-prod-upper
    (implies (and (rationalp x)
		  (not (= x 0))
		  (rationalp y)
		  (not (= y 0)))
	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo sig)
		  :use ((:instance *-doubly-strongly-monotonic
				   (x (abs x))
				   (y (expt 2 (1+ (expo x))))
				   (a (abs y))
				   (b (expt 2 (1+ (expo y)))))
			(:instance expo-upper-bound)
			(:instance expo-upper-bound (x y))
			(:instance expo-unique-1 (x (* x y)) (n (+ (expo x) (expo y) 1)))))))

(defun exactp (x n)
  (integerp (* (sig x) (expt 2 (1- n)))))

(defthm exactp-lemma
    (implies (and (rationalp x)
		  (integerp n))
	     (equal (* (sig x) (expt 2 (1- n)))
		    (* (abs x) (expt 2 (- (1- n) (expo x))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo))))

(defthm exactp2-lemma
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n))
	     (equal (exactp x n)
		    (integerp (* x (expt 2 (- (1- n) (expo x)))))))
  :hints (("Goal" :in-theory (disable expo sig)
		  :use ((:instance exactp-lemma)))))

(defthm integerp-neg
    (implies (rationalp x)
	     (iff (integerp x) (integerp (- x))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable a2))))

(defthm exact-neg
    (implies (and (rationalp x)
		  (integerp n))
	     (iff (exactp x n) (exactp (abs x) n)))
  :rule-classes ())


(defthm exactp2
    (implies (and (rationalp x)
		  (integerp n))
	     (equal (exactp x n)
		    (integerp (* x (expt 2 (- (1- n) (expo x)))))))
  :hints (("Goal" :in-theory (disable expo sig)
		  :use ((:instance exact-neg)
			(:instance exactp-lemma)
			(:instance integerp-neg (x  (* x (expt 2 (+ -1 n (* -1 (expo x)))))))))))

(in-theory (disable exactp))

(defthm exactp-shift
    (implies (and (rationalp x)
		  (integerp m)
		  (integerp n)
		  (exactp x m))
	     (exactp (* (expt 2 n) x) m))
  :hints (("Goal" :in-theory (disable expo sig sgn)
		  :use ((:instance sig-expo-shift)))))

(defthm integerp-expt
    (implies (and (integerp n)
		  (>= n 0))
	     (integerp (expt 2 n))))

(defthm exactp-prod-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (integerp m))
	     (= (expt 2 (+ m n -1 (- (expo (* x y)))))
		(* (expt 2 (- (1- m) (expo x)))
		   (expt 2 (- (1- n) (expo y)))
		   (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y))))))))
  :rule-classes ())

(defthm exactp-prod-2
    (implies (and (rationalp x)
		  (not (= x 0))
		  (rationalp y)
		  (not (= y 0)))
	     (integerp (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-prod-upper)))))

(defthm integerp-x-y-z
    (implies (and (integerp x) (integerp y) (integerp z))
	     (integerp (* x y z)))
  :rule-classes ())

(defthm exactp-prod
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp m)
		  (integerp n)
		  (exactp x m)
		  (exactp y n))
	     (exactp (* x y) (+ m n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance exactp-prod-1)
			(:instance exactp-prod-2)
			(:instance integerp-x-y-z 
				   (x (* x (expt 2 (- (1- m) (expo x)))))
				   (y (* y (expt 2 (- (1- n) (expo y)))))
				   (z (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))))))

(defthm exactp-x2-1
    (implies (and (rationalp x)
		  (integerp n))
	     (= (* 2 (expt 2 n) (expt 2 n))
		(expt 2 (+ n n 1))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo+ (m n))
			(:instance expo+ (m (* 2 n)) (n 1))))))

(defthm exactp-x2-2
    (implies (and (rationalp x)
		  (rationalp y))
	     (= (* 2 (* x y) (* x y))
		(* (* x x) (* 2 y y))))
  :rule-classes ())

(defthm exactp-x2-3
    (implies (and (rationalp x)
		  (integerp n))
	     (= (* 2 (* x (expt 2 n)) (* x (expt 2 n)))
		(* (* x x) (expt 2 (+ n n 1)))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance exactp-x2-1)
			(:instance exactp-x2-2 (y (expt 2 n)))))))

(defthm exactp-x2-4
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp e))
	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
		(* (* x x) (expt 2 (- (1- (* 2 n)) (* 2 e))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance exactp-x2-3 (n (- (1- n) e)))))))

(defthm exactp-x2-5
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp e)
		  (integerp e2))
	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
		(* (* (* x x) (expt 2 (- (1- (* 2 n)) e2)))
		   (expt 2 (- e2 (* 2 e))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance exactp-x2-4)
			(:instance expo+ (m (- (1- (* 2 n)) e2)) (n (- e2 (* 2 e))))))))

(defthm integerp-x-y
    (implies (and (integerp x)
		  (integerp y))
	     (integerp (* x y)))
  :rule-classes ())

(defthm exactp-x2-6
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp n)
		  (exactp (* x x) (* 2 n)))
	     (integerp (* 2 (* x (expt 2 (- (1- n) (expo x)))) (* x (expt 2 (- (1- n) (expo x)))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo expt)
		  :use ((:instance expo-prod-lower (y x))
			(:instance integerp-x-y 
				   (x (* (* x x) (expt 2 (- (1- (* 2 n)) (expo (* x x))))))
				   (y (expt 2 (- (expo (* x x)) (* 2 (expo x))))))
			(:instance exactp-x2-5 (e (expo x)) (e2 (expo (* x x))))))))

(include-book "x-2xx")

(defthm exactp-x2-not-zero
    (implies (and (rationalp x)
		  (not (= x 0))
		  (integerp k)
		  (exactp x k)
		  (integerp n)
		  (exactp (* x x) (* 2 n)))
	     (exactp x n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo expt)
		  :use ((:instance exactp-x2-6)
			(:instance x-2xx (k (- k n)) (x (* x (expt 2 (- (1- n) (expo x))))))))))

(defthm exactp-x2
    (implies (and (rationalp x)
		  (integerp k)
		  (exactp x k)
		  (integerp n)
		  (exactp (* x x) (* 2 n)))
	     (exactp x n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo expt)
		  :use ((:instance exactp-x2-not-zero)))))

(defthm exactp-<=
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp m)
		  (<= m n)
		  (exactp x m))
	     (exactp x n))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo+ (m (- (1- m) (expo x))) (n (- n m)))
			(:instance integerp-x-y 
				   (x (* x (expt 2 (- (1- m) (expo x))))) 
				   (y (expt 2 (- n m))))))))

(defthm exactp-<=-expo
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp e)
		  (<= e (expo x))
		  (exactp x n))
	     (integerp (* x (expt 2 (- (1- n) e)))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo+ (m (- (1- n) (expo x))) (n (- (expo x) e)))
			(:instance integerp-x-y 
				   (x (* x (expt 2 (- (1- n) (expo x))))) 
				   (y (expt 2 (- (expo x) e))))))))

(defthm exactp->=-expo
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp e)
		  (>= e (expo x))
		  (integerp (* x (expt 2 (- (1- n) e)))))
	     (exactp x n))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo+ (m (- (1- n) e)) (n (- e (expo x))))
			(:instance integerp-x-y 
				   (x (* x (expt 2 (- (1- n) e))))
				   (y (expt 2 (- e (expo x)))))))))

(defthm expo-diff
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp k)
		  (integerp n)
		  (> n 0)
		  (> n k)
		  (exactp x n)
		  (exactp y n)
		  (<= (+ k (expo (- x y))) (expo x))
		  (<= (+ k (expo (- x y))) (expo y)))
	     (exactp (- x y) (- n k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance exactp-<=-expo (e (+ k (expo (- x y)))))
			(:instance exactp-<=-expo (e (+ k (expo (- x y)))) (x y))))))

(defthm expo-diff-0
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n)
		  (<= (expo (- x y)) (expo x))
		  (<= (expo (- x y)) (expo y)))
	     (exactp (- x y) n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-diff (k 0))))))

(defthm expo-diff-cor
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n)
		  (<= (abs (- x y)) (abs x))
		  (<= (abs (- x y)) (abs y)))
	     (exactp (- x y) n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo exactp2)
		  :use ((:instance expo-diff-0)
			(:instance expo-monotone (x (- x y)) (y x))
			(:instance expo-monotone (x (- x y)))))))

(defun fp+ (x n)
  (+ x (expt 2 (- (1+ (expo x)) n))))

(defthm fp+1-1
    (implies (and (rationalp x)
		  (> x 0)
		  (rationalp y)
		  (> y x)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (integerp (* (- y x) (expt 2 (- (1- n) (expo x))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-monotone)
			(:instance exactp-<=-expo (x y) (e (expo x)))))))

(defthm int>0
    (implies (and (integerp n)
		  (> n 0))
	     (>= n 1))
  :rule-classes ())

(defthm fp+1
    (implies (and (rationalp x)
		  (> x 0)
		  (rationalp y)
		  (> y x)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (>= y (fp+ x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo+ (m (- (1- n) (expo x))) (n (- (1+ (expo x)) n)))
			(:instance fp+1-1)
			(:instance int>0 (n (* (- y x) (expt 2 (- (1- n) (expo x))))))))))

(defthm expo-2**n
    (implies (integerp n)
	     (equal (expo (expt 2 n))
		    n)))

(defthm fp+2-1
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n))
	     (<= (fp+ x n) (expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance fp+1 (y (expt 2 (1+ (expo x)))))
			(:instance expo-upper-bound)))))

(defthm x<fp+
    (implies (and (rationalp x)
		  (integerp n))
	     (> (fp+ x n) x))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo expt-pos)
		  :use ((:instance expt-pos (x (- (1+ (expo x)) n)))))))

(defthm ratl-fp+
    (implies (and (rationalp x)
		  (integerp n))
	     (rationalp (fp+ x n))))

(defthm expo-squeeze
    (implies (and (rationalp x)
		  (integerp n)
		  (<= (expt 2 n) (abs x))
		  (< (abs x) (expt 2 (1+ n))))
	     (= (expo x) n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expt-strong-monotone (n (expo x)) (m (1+ n)))
			(:instance expt-strong-monotone (m (1+ (expo x))))
			(:instance expo-lower-bound)
			(:instance expo-upper-bound)))))

(defthm fp+2-2
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n))
	     (or (= (fp+ x n) (expt 2 (1+ (expo x))))
		 (= (expo (fp+ x n)) (expo x))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable fp+ expo)
		  :use ((:instance fp+2-1)
			(:instance x<fp+)
			(:instance expo-lower-bound)
			(:instance expo-squeeze (x (fp+ x n)) (n (expo x)))))))

(defthm fp+2
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n))
	     (exactp (fp+ x n) n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance fp+2-2)))))

(defthm expo-diff-min-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n)
		  (> y x))
	     (>= (expo (- y x)) (- (1+ (expo x)) n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance fp+1)
			(:instance expo-monotone (y (- y x)) (x (expt 2 (- (1+ (expo x)) n))))))))

(defthm expo-diff-min-2
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n)
		  (> y x))
	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo exactp)
		  :use ((:instance expo-diff-min-1)			
			(:instance expo-monotone)))))

(defthm expo-
    (implies (rationalp x)
	     (= (expo (- x)) (expo x)))
  :rule-classes ())

(defthm expo-diff-min
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n)
		  (not (= y x)))
	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable exactp2 expo)
		  :use ((:instance expo-diff-min-2)
			(:instance expo-diff-min-2 (x y) (y x))
			(:instance expo- (x (- y x)))))))

(defun expo-ok-p (x j)
  (let ((e (expo x))
	(b (expt 2 (1- j))))
    (and (<= (- 1 b) e)
	 (<= e b))))

(defun floating-point-p (x i j)
  (and (exactp x i)
       (expo-ok-p x j)))

(defun expo-ok-p-+ (x i j)
  (let ((e (expo x))
	(b (expt 2 (1- j))))
    (and (<= (- (- 2 i) b) e)
	 (<= e b))))

(defun generalized-floating-point-p (x i j)
  (and (exactp x i)
       (expo-ok-p-+ x i j)))

(defthm exactp-2**n
    (implies (and (integerp n)
		  (integerp m)
		  (> m 0))
	     (exactp (expt 2 n) m))
  :rule-classes ())

(defthm expo-upper-2
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (< (abs x) (expt 2 n)))
	     (< (expo x) n))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-lower-bound)
			(:instance expt-strong-monotone (n (expo x)) (m n))))))

(defthm xy2-1
    (implies (and (rationalp z)
		  (<= (abs (- 1 z)) 1/2))
	     (and (<= -1 (expo z))
		  (<= (expo z) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-monotone (x 1/2) (y z))
			(:instance expo-monotone (x z) (y 3/2))))))

(defthm xy2-2
    (implies (and (rationalp z)
		  (<= (abs (- 1 z)) 1/2))
	     (<= (abs (expo z)) 1))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-1)))))

(defthm abs+2
    (implies (and (rationalp x1)
		  (rationalp x2))
	     (<= (abs (+ x1 x2)) (+ (abs x1) (abs x2))))
  :rule-classes ())

(defthm abs+3
    (implies (and (rationalp x1)
		  (rationalp x2)
		  (rationalp x3))
	     (<= (abs (+ x1 x2 x3)) (+ (abs x1) (abs x2) (abs x3))))
  :rule-classes ())

(defthm xy2-3
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (and (not (= x 0)) (not (= y 0))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-1)))))


(defthm xy2-4
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (- (* 2 (expo y)) (expo (* y y)))) 1))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-3)
			(:instance expo-prod-lower (x y))
			(:instance expo-prod-upper (x y))))))

(defthm xy2-5
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))) 1))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-3)
			(:instance expo-prod-lower (y (* y y)))
			(:instance expo-prod-upper (y (* y y)))))))

(defthm xy2-6
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (+ (* 2 (expo y)) (expo x))) 3))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance xy2-2 (z (* x y y)))
			(:instance xy2-4)
			(:instance xy2-5)
			(:instance abs+3 
				   (x1 (- (* 2 (expo y)) (expo (* y y))))
				   (x2 (expo (* x y y)))
				   (x3 (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))))))))

(defthm abs-2
    (implies (and (rationalp x1)
		  (rationalp x2))
	     (<= (abs (- x1 x2)) (+ (abs x1) (abs x2))))
  :rule-classes ())

(defthm xy2-7
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (* 2 (expo y))) (+ 3 (abs (expo x)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance xy2-6)
			(:instance abs-2
				   (x1 (+ (* 2 (expo y)) (expo x)))
				   (x2 (expo x)))))))

(defthm xy2-a
    (implies (and (rationalp x)
		  (rationalp y)
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (< (abs (expo y)) (+ (/ (abs (expo x)) 2) 2)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-7)))))

(defthm xy2-8
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp xp)
		  (not (= xp 0))
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
		 2))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-3)
			(:instance expo-prod-lower (x xp))
			(:instance expo-prod-upper (x xp))))))

(defthm hack4
    (implies (and (rationalp a)
		  (rationalp b)
		  (rationalp c))
	     (= (+ (* 2 a)
		   (* 2 b)
		   (* -2 a)
		   (* -2 b)
		   (* 2 c))
		(* 2 c)))
  :rule-classes ())

(defthm xy2-9
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp xp)
		  (= (expo xp) (expo x))
		  (not (= xp 0))
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (* 2 (expo (* xp y))))
		 (+ 5 (abs (expo x)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance abs+3
				   (x1 (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
				   (x2 (+ (* 2 (expo y)) (expo xp)))
				   (x3 (expo xp)))
			(:instance hack4 (a (expo x)) (b (expo y)) (c (expo (* xp y))))
			(:instance xy2-8)
			(:instance xy2-6)))))

(defthm xy2-10
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp xp)
		  (= (expo xp) (expo x))
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (<= (abs (* 2 (expo (* xp y))))
		 (+ 5 (abs (expo x)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-9)))))

(defthm xy2-b
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp xp)
		  (= (expo xp) (expo x))
		  (<= (abs (- 1 (* x y y))) 1/2))
	     (< (abs (expo (* xp y))) (+ (/ (abs (expo x)) 2) 3)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance xy2-10)))))


(defthm expo-diff-abs-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x y)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (>= (expo (- y x))
		 (- (expo y) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-diff-min)
			(:instance expo-monotone (x y) (y x))))))

(defthm expo-diff-abs-2
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x y)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (expo (- y x))
		 (expo x)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-monotone (x (- y x)) (y x))))))

(defthm expo-diff-abs-3
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (> n 0))
	     (<= (abs (- (expo y) (1- n)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo))))

(defthm expo-diff-abs-4
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (> n 0))
	     (<= (abs (expo x))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo))))

(defthm abs-squeeze
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp z)
		  (rationalp m)
		  (<= x y)
		  (<= y z)
		  (<= (abs x) m)
		  (<= (abs z) m))
	     (<= (abs y) m))
  :rule-classes ())

(defthm rationalp-abs
    (implies (rationalp x)
	     (rationalp (abs x))))

(defthm expo-diff-abs-5
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x y)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- y x)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance abs-squeeze
				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
				   (x (- (expo y) (1- n)))
				   (y (expo (- y x)))
				   (z (expo x)))
			(:instance expo-diff-abs-1)
			(:instance expo-diff-abs-2)
			(:instance expo-diff-abs-3)
			(:instance expo-diff-abs-4)))))

(defthm expo-neg
    (implies (rationalp x)
	     (= (expo (- x)) (expo x)))
  :rule-classes ())

(defthm expo-diff-abs-6
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (not (= x y))
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-5)
			(:instance expo-diff-abs-5 (x y) (y x))
			(:instance expo-neg (x (- x y)))))))

(defthm expo-diff-abs-7
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (= x y)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" ;:in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-5)
			(:instance expo-diff-abs-5 (x y) (y x))
			(:instance expo-neg (x (- x y)))))))

(defthm expo-diff-abs
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" ;:in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-6)
			(:instance expo-diff-abs-7)))))

(defthm expo-2x-upper
    (implies (rationalp x)
	     (<= (expo (* 2 x)) (1+ (expo x))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance expo-upper-2 (x (* 2 x)) (n (+ 2 (expo x))))
		 (:instance expo-upper-bound)
		 (:instance expo+ (n (1+ (expo x))) (m 1))))))


(defthm expo-diff-abs-neg-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (>= x y)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (expo (+ x y))
		 (+ (expo x) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-2x-upper)		 
			(:instance expo-monotone (x (+ x y)) (y (* 2 x)))))))

(defthm expo-diff-abs-neg-2
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (>= x y)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (expo x) (expo (+ x y))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-monotone (y (+ x y)))))))

(defthm abs-pos
    (implies (and (rationalp x)
		  (>= x 0))
	     (equal (abs x) x)))

(defthm expo-diff-abs-neg-3
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (>= x y)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (+ x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-neg-1)
			(:instance expo-diff-abs-neg-2)
			(:instance abs-squeeze
				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
				   (x (expo x))
				   (y (expo (+ y x)))
				   (z (+ (expo x) (1- n))))
			(:instance abs+2 (x1 (expo x)) (x2 (1- n)))))))

(defthm expo-diff-abs-neg-4
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (+ x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-neg-3)
			(:instance expo-diff-abs-neg-3 (x y) (y x))))))

(defthm expo-diff-abs-neg-5
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (< y 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-neg-4 (y (- y)))
			(:instance expo-neg (x y))))))

(defthm expo-diff-abs-neg-6
    (implies (and (rationalp x)
		  (rationalp y)
		  (< x 0)
		  (> y 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs)
		  :use ((:instance expo-diff-abs-neg-4 (x (- x)))
			(:instance expo-neg (x (- x y)))
			(:instance expo-neg)))))

(defthm expo-diff-abs-neg-neg
    (implies (and (rationalp x)
		  (rationalp y)
		  (< x 0)
		  (< y 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo abs max)
		  :use ((:instance expo-diff-abs (x (- x)) (y (- y)))
			(:instance expo-neg)
			(:instance expo-neg (x (- x y)))
			(:instance expo-neg (x y))))))

(defthm expo-diff-abs-zero-y
    (implies (and (rationalp x)
		  (rationalp y)
		  (= y 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ())

(defthm expo-diff-abs-zero-x
    (implies (and (rationalp x)
		  (rationalp y)
		  (= x 0)
		  (integerp n)
		  (> n 0)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo)
		  :use ((:instance expo-neg (x y))))))

(defthm expo-diff-abs-neg-x
    (implies (and (rationalp x)
		  (rationalp y)
		  (< x 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable max expo abs exactp2)
		  :use ((:instance expo-diff-abs-zero-y)
			(:instance expo-diff-abs-neg-6)
			(:instance expo-diff-abs-neg-neg)))))

(defthm expo-diff-abs-pos-x
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable max expo abs exactp2)
		  :use ((:instance expo-diff-abs-zero-y)
			(:instance expo-diff-abs)
			(:instance expo-diff-abs-neg-5)))))

(defthm expo-diff-abs-any
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp n)
		  (> n 1)
		  (exactp x n)
		  (exactp y n))
	     (<= (abs (expo (- x y)))
		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable max expo abs exactp2)
		  :use ((:instance expo-diff-abs-zero-x)
			(:instance expo-diff-abs-neg-x)
			(:instance expo-diff-abs-pos-x)))))
