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

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

(in-package "ACL2")

(local (include-book "../arithmetic/top"))
(local (include-book "float"))
(local (include-book "away"))
(local (include-book "trunc"))

;; Necessary functions:

(defund fl (x)
  (declare (xargs :guard (real/rationalp x)))
  (floor x 1))

(defund cg (x)
  (declare (xargs :guard (real/rationalp x)))
  (- (fl (- x))))

(defun expo-measure (x)
;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
  (cond ((not (rationalp x)) 0)
	((< x 0) '(2 . 0))
	((< x 1) (cons 1 (fl (/ x))))
	(t (fl x))))

(defund expo (x)
  (declare (xargs :guard t
                  :measure (expo-measure x)))
  (cond ((or (not (rationalp x)) (equal x 0)) 0)
	((< x 0) (expo (- x)))
	((< x 1) (1- (expo (* 2 x))))
	((< x 2) 0)
	(t (1+ (expo (/ x 2))))))

;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
(defund sig (x)
  (declare (xargs :guard t))
  (if (rationalp x)
      (if (< x 0)
          (- (* x (expt 2 (- (expo x)))))
        (* x (expt 2 (- (expo x)))))
    0))

;make defund?
(defun sgn (x)
  (declare (xargs :guard t))
  (if (or (not (rationalp x)) (equal x 0))
      0
    (if (< x 0)
        -1
      1)))

(defund exactp (x n)
;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
  (integerp (* (sig x) (expt 2 (1- n)))))

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

(defund trunc (x n)
  (declare (xargs :guard (integerp n)))
  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))

(defund away (x n)
  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))


;;
;; New stuff:
;;


(defund re (x)
  (- x (fl x)))

(defund near (x n)
  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
	(f (re (* (expt 2 (1- n)) (sig x)))))
    (if (< f 1/2)
	(trunc x n)
      (if (> f 1/2)
	  (away x n)
	(if (evenp z)
	    (trunc x n)
	  (away x n))))))

(defthm near-minus
  (equal (near (* -1 x) n)
         (* -1 (near x n)))
  :hints (("goal" :in-theory (enable near sig-minus))))

(defthm near-of-non-rationalp-is-0
  (implies (not (rationalp x))
           (equal (near x n)
                  0))
  :hints (("goal" :in-theory (enable near sig))))

(defthm near-choice
  (or (= (near x n) (trunc x n))
      (= (near x n) (away x n)))
  :hints (("Goal" :in-theory (enable near)))
  :rule-classes ())

;BOZO better r-c on these? :rewrite?
(defthm near-pos
  (implies (and (< 0 x)
                (< 0 n)
                (rationalp x)
                (integerp n)
                )
           (< 0 (near x n)))
  :rule-classes (:type-prescription :linear)
  :hints (("Goal" :use ((:instance near-choice)))))

(defthm near-neg
    (implies (and (< x 0)
		  (< 0 n)
                  (rationalp x)
		  (integerp n)
		  )
	     (< (near x n) 0))
  :rule-classes (:type-prescription :linear)
  :hints (("Goal" :use ((:instance near-choice)))))

(defthm near-rational-type-prescription
  (rationalp (near x n))
  :rule-classes (:rewrite :type-prescription))

(defthm near-non-negative-rational-type-prescription
  (implies (<= 0 x)
           (and (<= 0 (near x n))
                (rationalp (near x n))))
  :hints (("Goal" :use ((:instance near-choice))))
  :rule-classes :type-prescription)

(defthm near-non-positive-rational-type-prescription
  (implies (<= x 0)
           (and (<= (near x n) 0)
                (rationalp (near x n))))
  :hints (("Goal" :use ((:instance near-choice))))
  :rule-classes :type-prescription)


(local (defthm near1-1
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n)
		  ;(> n 0)
                  )
	     (= (- x (trunc x n))
		(* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable re a15)
		  :use ((:instance trunc)
			(:instance fp-rep))))))

(local (defthm near1-3
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n)
;		  (> n 0)
		  (not (integerp (* (expt 2 (1- n)) (sig x))))
                  )
	     (= (- (away x n) x)
		(* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable re a15)
		  :use ((:instance away)
			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x))))
			(:instance fp-rep)
		)))))


(local (defthm near1-6
    (implies (and (rationalp p)
		  (> p 0)
		  (rationalp f)
		  (< (* p f) (* p (- 1 f))))
	     (< f 1/2))
;    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE)))
    :rule-classes ()))

(local (defthm near1-7
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n)
		  (> n 0)
		  (not (integerp (* (expt 2 (1- n)) (sig x)))) ;easy to drop, since trunc, away, and near all
                    ;= x
		  (< (- x (trunc x n)) (- (away x n) x)))
	     (= (near x n) (trunc x n)))
  :rule-classes ()
  :hints (("Goal"
		  :use ((:instance near1-1)
			(:instance near1-3)
			(:instance near1-6 
				   (p (expt 2 (- (1+ (expo x)) n))) 
				   (f (re (* (expt 2 (1- n)) (sig x)))))
			(:instance near))))))

(local (defthm near1-8
    (implies (and (rationalp p)
		  (> p 0)
		  (rationalp f)
		  (> (* p f) (* p (- 1 f))))
	     (> f 1/2))
    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE)))
    :rule-classes ()))

(local (defthm near1-9
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n)
		  (> n 0)
		  (not (integerp (* (expt 2 (1- n)) (sig x))))
		  (> (- x (trunc x n)) (- (away x n) x)))
	     (= (near x n) (away x n)))
  :rule-classes ()
  :hints (("Goal"
		  :use ((:instance near1-1)
			(:instance near1-3)
			(:instance near1-8 
				   (p (expt 2 (- (1+ (expo x)) n))) 
				   (f (re (* (expt 2 (1- n)) (sig x)))))
			(:instance near))))))

(defthm near1-a-helper
    (implies (and (rationalp x)
		  (>= x 0)
		  (integerp n)
		  (> n 0)
		  (< (- x (trunc x n)) (- (away x n) x)))
	     (= (near x n) (trunc x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable exactp)
		  :use ((:instance near1-7)
                        trunc-exactp-a
                        away-exactp-a
			;(:instance near1-4)
			;(:instance near1-5)
                        ))))

;disable re?
;use  near1-7? no, this is the "negative n case"
(defthm near1-a-negative-n
  (implies (and (rationalp x)
                (>= x 0)
                (integerp n)
                (<= n 0)
                (< (- x (trunc x n)) (- (away x n) x)))
           (= (near x n) (trunc x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (set-difference-theories
                              (enable sgn
                                      re
;                                      sig
                                      near; expo>=-2
                                      expt-split)
                              '(;integerp-prod
                                expt-compare
                                a15
                                ;expo>=-2
                                ))
           :use ((:instance expt-weak-monotone (n n) (m 0))
                 (:instance expt-weak-monotone (n n) (m -1))
                 sig-upper-bound
                 (:instance fl-unique (x (* 1/2 (SIG X) (EXPT 2 N))) (n 0))))))

(defthm near1-a
  (implies (and (< (- x (trunc x n)) (- (away x n) x))
                (rationalp x)
                (>= x 0)
                (integerp n)
; (> n 0)
                )
           (equal (near x n)
                  (trunc x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near trunc away)
           :use (near1-a-helper near1-a-negative-n))))


(defthm near1-b
    (implies (and (> (- x (trunc x n)) (- (away x n) x))
                  (rationalp x)
		  (>= x 0)
		  (integerp n)
		  (> n 0)
		  )
	     (equal (near x n)
                    (away x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable exactp)
		  :use ((:instance near1-9)
                        trunc-exactp-a
                        away-exactp-a))))

(defthm near2-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (>= x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp y n)
		  (= (near x n) (trunc x n)))
	     (>= (abs (- x y)) (- x (trunc x n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable away-exactp-c 
				      near trunc-exactp-c)
		  :use ((:instance near1-b)
			(:instance away-lower-bound)
			(:instance trunc-upper-bound)
			(:instance trunc-exactp-c (a y))
			(:instance away-exactp-c (a y))))))

(defthm near2-2
    (implies (and (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  (exactp y n)
		  (= (near x n) (away x n)))
	     (>= (abs (- x y)) (- (away x n) x)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable away-exactp-c 
				      trunc-exactp-c)
		  :use ((:instance near1-a)
			(:instance away-lower-pos)
			(:instance trunc-upper-pos)
			(:instance trunc-exactp-c (a y))
			(:instance away-exactp-c (a y))))))



(defthm near2
    (implies (and (exactp y n)
                  (rationalp x)
		  (rationalp y)
		  (> x 0)
		  (> y 0)
		  (integerp n)
		  (> n 0)
		  )
	     (>= (abs (- x y)) (abs (- x (near x n)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near)
		  :use ((:instance near2-1)
			(:instance near2-2)
			(:instance near-choice)
			(:instance away-lower-pos)
			(:instance trunc-upper-pos)))))

(defthm near-exactp-b
  (implies (< 0 n) ;can't drop?
           (exactp (near x n) n))
  :hints (("Goal" :in-theory (disable near trunc-exactp-b away-exactp-b)
           :use ((:instance near-choice)
                 (:instance trunc-exactp-b)
                 (:instance away-exactp-b)))))

(defthm sgn-near-2
    (implies (and (rationalp x)
		  (integerp n)
		  (> n 0))
	     (equal (sgn (near x n))
		    (sgn x)))
  :hints (("Goal" :use (near-choice
			sgn-trunc
			sgn-away))))

(defthm near-exactp-a
    (implies (and (rationalp x)
		  (integerp n) 
		  (> n 0))
	     (iff (= x (near x n))
		  (exactp x n)))
  :rule-classes ()
  :hints (("Goal" :use (near-choice
			trunc-exactp-a
			away-exactp-a))))



(defthm near-exactp-c
    (implies (and (exactp a n)
		  (>= a x)
                  (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0)
		  (rationalp a)
		  )
	     (>= a (near x n)))
  :hints (("Goal" :use (near-choice
			away-exactp-c
			trunc-upper-pos))))

(defthm near-exactp-d
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0)
		  (rationalp a)
		  (exactp a n)
		  (<= a x))
	     (<= a (near x n)))
  :hints (("Goal" :use (near-choice
			away-lower-pos
			trunc-exactp-c))))


;BOZO gen!
(defthm near-monotone
  (implies (and (<= x y)
                (rationalp x)
                (rationalp y)
                (< 0 x)
                (integerp n)
                (> n 0))
           (<= (near x n) (near y n)))
  :hints (("Goal" :in-theory (disable near trunc-exactp-b away-exactp-b)
           :use ((:instance near-pos)
                 (:instance near-pos (x y))
                 (:instance near2 (y (near y n)))
                 (:instance near2 (x y) (y (near x n)))))))

(defund near-witness (x y n)
  (if (= (expo x) (expo y))
      (/ (+ (near x n) (near y n)) 2)
    (expt 2 (expo y))))

(local 
 (defthm near-near-1
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (not (= (expo x) (expo y))))
	     (and (<= x (near-witness x y n))
		  (<= (near-witness x y n) y)
		  (exactp (near-witness x y n) (1+ n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable near-witness)
		  :use ((:instance exactp-2**n (n (expo y)) (m (1+ n)))
			(:instance expo-upper-bound)
			(:instance expo-monotone)
			(:instance expt-weak-monotone (n (1+ (expo x))) (m (expo y)))
			(:instance expo-lower-bound (x y)))))))

(local
 (defthm near-near-2
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (< (near x n) (near y n))
		  (= (expo x) (expo y)))
	     (and (<= x (near-witness x y n))
		  (<= (near-witness x y n) y)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable near-witness)
		  :use ((:instance near2 (y (near y n)))
			(:instance near2 (x y) (y (near x n)))
			(:instance near-pos)
			(:instance near-pos (x y)))))))

(local
 (defthm near-near-3
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (not (= (near x n) (near y n)))
		  (= (expo x) (expo y)))
	     (and (<= x (near-witness x y n))
		  (<= (near-witness x y n) y)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near near-monotone near-witness)
		  :use ((:instance near-near-2)
			(:instance near-monotone))))))

(defthm near<=away
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0))
	     (<= (near x n) (away x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near)
		  :use ((:instance near-choice)
			(:instance trunc-upper-pos)
			(:instance away-lower-pos)))))

(defthm near>=trunc
    (implies (and (rationalp x)
		  (> x 0)
		  (integerp n)
		  (> n 0))
	     (>= (near x n) (trunc x n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near)
		  :use ((:instance near-choice)
			(:instance trunc-upper-pos)
			(:instance away-lower-pos)))))
(local
 (defthm near-near-4
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (< (near x n) (near y n))
		  (= (expo x) (expo y)))
	     (<= (expo (near-witness x y n)) (expo y)))
  :rule-classes ()
  :hints (("Goal" :in-theory (set-difference-theories
                              (enable near-witness)
                              '( abs-away  away-lower-pos))
		  :use ((:instance near<=away (x y))
			(:instance away-exactp-d (x y))
			(:instance near-pos)
;			(:instance away-pos (x y))
			(:instance expo-upper-2 (x (near-witness x y n)) (n (1+ (expo y)))))))))



(defthm near-0-0
  (implies (and (case-split (< 0 n))
                (case-split (rationalp x))
                (case-split (integerp n))
                )
           (equal (equal (near x n) 0)
		  (equal x 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable near))))

(local
 (defthm near-near-5
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (< (near x n) (near y n))
		  (= (expo x) (expo y)))
	     (integerp (* (near x n) (expt 2 (- (1- n) (expo y))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo-trunc EXPO-COMPARISON-REWRITE-TO-BOUND-2)
		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near x n)))
			(:instance expo-monotone (x (trunc x n)) (y (near x n)))
;			(:instance trunc-pos)
			(:instance near-pos)
			(:instance expo-trunc)
			(:instance near>=trunc))))))

(local
 (defthm near-near-6
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (< (near x n) (near y n))
		  (= (expo x) (expo y)))
	     (integerp (* (near y n) (expt 2 (- (1- n) (expo y))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable expo-trunc  EXPO-COMPARISON-REWRITE-TO-BOUND-2)
		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near y n)))
			(:instance expo-monotone (x (trunc x n)) (y (near y n)))
			(:instance near-monotone)
;			(:instance trunc-pos)
			(:instance near-pos)
			(:instance expo-trunc)
			(:instance near>=trunc))))))

;gross?
(local
 (defthm near-near-7
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp k))
	     (= (+ (* x (expt 2 (1- k)))
		   (* y (expt 2 (1- k))))
		(* (/ (+ x y) 2) (expt 2 k))))
    :hints (("Goal" :in-theory (enable expt))) ;yuck
  :rule-classes ()))

(local
 (defthm near-near-8
    (implies (and (rationalp x)
		  (rationalp y)
		  (integerp k)
	          (integerp (* x (expt 2 (1- k))))
	          (integerp (* y (expt 2 (1- k)))))
	     (integerp (* (/ (+ x y) 2) (expt 2 k))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-near-7))))))

(local
 (defthm near-near-9
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (< (near x n) (near y n))
		  (= (expo x) (expo y)))
	     (exactp (near-witness x y n) (1+ n)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable near-witness)
           :use ((:instance near-near-5)
			(:instance near-near-6)
			(:instance near-near-4)
			(:instance near-near-8 (x (near x n)) (y (near y n)) (k (- n (expo y))))
			(:instance exactp->=-expo (n (1+ n)) (e (expo y)) (x (near-witness x y n))))))))

(defthm near-near-lemma
    (implies (and (rationalp x)
		  (rationalp y)
		  (< 0 x)
		  (< x y)
		  (integerp n)
		  (> n 0)
		  (not (= (near x n) (near y n))))
	     (and (<= x (near-witness x y n))
		  (<= (near-witness x y n) y)
		  (exactp (near-witness x y n) (1+ n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near near-monotone)
		  :use ((:instance near-near-2)
			(:instance near-near-1)
			(:instance near-near-9)
			(:instance near-monotone)))))

(local
 (defthm near-near-10
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp a)
		  (integerp n)
		  (integerp k)
		  (> k 0)
		  (>= n k)		  
		  (< 0 a)
		  (< a x)
		  (< 0 y)
		  (< x y)
		  (< y (fp+ a (1+ n)))
		  (exactp a (1+ n)))
	     (= (near y k) (near x k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable near near-monotone)
		  :use ((:instance near-near-lemma (n k))
			(:instance exactp-<= (x (near-witness x y k)) (m (1+ k)) (n (1+ n)))
			(:instance fp+1 (x a) (y (near-witness x y k)) (n (1+ n))))))))

;bad name?
(defthm near-near
    (implies (and (rationalp x)
		  (rationalp y)
		  (rationalp a)
		  (integerp n)
		  (integerp k)
		  (> k 0)
		  (>= n k)		  
		  (< 0 a)
		  (< a x)
		  (< 0 y)
		  (< y (fp+ a (1+ n)))
		  (exactp a (1+ n)))
	     (<= (near y k) (near x k)))
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-near-10)
			(:instance near-monotone (n k) (x y) (y x))))))


;why disabled?
(defthmd near-shift
    (implies (and (rationalp x)
		  (integerp n)
		  (integerp k))
	     (= (near (* x (expt 2 k)) n)
		(* (near x n) (expt 2 k))))
  :hints (("goal" :in-theory (enable near)
		  :use (trunc-shift
			away-shift
			(:instance sig-expo-shift (n k))))))


(local
 (defthm near-a-a-1
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (exactp a n)
                 (> (near x n) a))
            (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
   :rule-classes ()
   :hints (("goal" :use ((:instance fp+1 (x a) (y (near x n)))
)))))

(local
 (defthm near-a-a-2
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (rationalp d) (> d 0)
                 (integerp n) (> n 0)
                 (<= (near x n) a)
                 (> x (+ a d)))
            (> (abs (- (near x n) x))
               (abs (- (+ a d d)
                       x))))
   :rule-classes ()))

(local
 (defthm near-a-a-3
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (<= (near x n) a)
                 (> x (+ a (expt 2 (- (expo a) n)))))
            (> (abs (- (near x n) x))
               (abs (- (+ a 
                          (expt 2 (- (expo a) n))
                          (expt 2 (- (expo a) n)))
                       x))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance near-a-a-2 (d (expt 2 (- (expo a) n))))
;			(:instance expt-pos (x (- (expo a) n)))
                  )))))

(local
 (defthm near-a-a-4
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (<= (near x n) a)
                 (> x (+ a (expt 2 (- (expo a) n)))))
            (> (abs (- (near x n) x))
               (abs (- (+ a (expt 2 (- (1+ (expo a)) n)))
                       x))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare-equal)
            :use ((:instance near-a-a-3)
                         (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))

(defthm near-a-a
  (implies (and (rationalp x) (> x 0)
                (rationalp a) (> a 0)
                (integerp n) (> n 0)
                (exactp a n)
                (> x (+ a (expt 2 (- (expo a) n)))))
           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
           :use ((:instance near2 (y (+ a (expt 2 (- (1+ (expo a)) n)))))
                 (:instance near-a-a-4)
                 (:instance near-a-a-1)
                 (:instance fp+2 (x a))
;			(:instance expt-pos (x (- (1+ (expo a)) n)))
                 ))))

(local
 (defthm near-a-b-1
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (rationalp d) (> d 0)
                 (integerp n) (> n 0)
                 (>= (near x n) (+ a d d))
                 (< x (+ a d)))
            (> (abs (- (near x n) x))
               (abs (- a x))))
   :rule-classes ()))

(local
 (defthm near-a-b-2
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (>= (near x n) 
                     (+ a
                        (expt 2 (- (expo a) n))
                        (expt 2 (- (expo a) n))))
                 (< x (+ a (expt 2 (- (expo a) n)))))
            (> (abs (- (near x n) x))
               (abs (- a x))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance near-a-b-1 (d (expt 2 (- (expo a) n))))
;			(:instance expt-pos (x (- (expo a) n)))
                  )))))

(local
 (defthm near-a-b-3
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (>= (near x n) 
                     (+ a (expt 2 (- (1+ (expo a)) n))))
                 (< x (+ a (expt 2 (- (expo a) n)))))
            (> (abs (- (near x n) x))
               (abs (- a x))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare-equal)
            :use ((:instance near-a-b-2)
                  (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))

(defthm near-a-b
    (implies (and (rationalp x) (> x 0)
		  (rationalp a) (> a 0)
		  (integerp n) (> n 0)
		  (exactp a n)
		  (< x (+ a (expt 2 (- (expo a) n)))))
	     (<= (near x n) a))
  :rule-classes ()
  :hints (("goal" :use ((:instance near2 (y a))
			(:instance near-a-b-3)
			(:instance near-a-a-1)))))

(local
 (defthm near-a-c-1
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (exactp a n)
                 (>= x a))
            (>= (near x n) a))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-monotone (x a) (y x))
                         (:instance near-choice (x a))
                         (:instance trunc-exactp-a (x a))
                         (:instance away-exactp-a (x a)))))))

(local
(defthm near-a-c-2
    (implies (and (rationalp x) (> x 0)
		  (rationalp a) (> a 0)
		  (integerp n) (> n 0)
		  (exactp a n)
		  (< x a))
	     (>= a 
		 (+ (expt 2 (expo x))
		    (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance expo-lower-bound)
			(:instance fp+1 (x (expt 2 (expo x))) (y a))
			(:instance exactp-2**n (n (expo x)) (m n)))))))

(local
 (defthm near-a-c-3
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (> x (- a (expt 2 (- (expo x) n)))))
            (> x (- a (expt 2 (- (1+ (expo x)) n)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare)
            :use ((:instance expt-weak-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))

(local
 (defthm near-a-c-4
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (exactp a n)
                 (< x a)
                 (> x (- a (expt 2 (- (expo x) n)))))
            (= (expo (- a (expt 2 (- (1+ (expo x)) n))))
               (expo x)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance near-a-c-2)
                  (:instance near-a-c-3)
;			(:instance expt-pos (x (expo x)))
                  (:instance expo-upper-bound)
                  (:instance expo-unique
                             (x (- a (expt 2 (- (1+ (expo x)) n))))
                             (n (expo x))))))))

(local
(defthm near-a-c-5
    (implies (and (rationalp x) (> x 0)
		  (rationalp a) (> a 0)
		  (integerp n) (> n 0)
		  (exactp a n)
		  (< x a)
		  (> x (- a (expt 2 (- (expo x) n)))))
	     (integerp (* (- a (expt 2 (- (1+ (expo x)) n)))
			  (expt 2 (- (1- n) (expo x))))))
  :rule-classes ()
  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (1+ (expo x)) n)) (j (- (1- n) (expo x))))
			(:instance exactp-<=-expo (x a) (e (expo x)))
			(:instance near-a-c-3)
			(:instance expo-monotone (x (- a (expt 2 (- (1+ (expo x)) n)))) (y a))
			(:instance expo-monotone (y a)))))))

(local
(defthm near-a-c-6
    (implies (and (rationalp x) (> x 0)
		  (rationalp a) (> a 0)
		  (integerp n) (> n 0)
		  (exactp a n)
		  (< x a)
		  (> x (- a (expt 2 (- (expo x) n)))))
	     (exactp (- a (expt 2 (- (1+ (expo x)) n)))
		     n))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance exactp2 (x (- a (expt 2 (- (1+ (expo x)) n)))))
			(:instance near-a-c-5)
			(:instance near-a-c-2)
;			(:instance expt-pos (x (expo x)))
			(:instance near-a-c-4))))))

(local
(defthm near-a-c-7
    (implies (and (rationalp x)
		  (rationalp a)
		  (rationalp e)
		  (> x (- a e)))
	     (> x (+ (- a (* 2 e))
		     e)))
  :rule-classes ()))

(local
 (defthm near-a-c-8
   (implies (and (rationalp x)
                 (rationalp a)
                 (integerp n)
                 (> x (- a (expt 2 (- (expo x) n)))))
            (> x (+ (- a (expt 2 (- (1+ (expo x)) n)))
                    (expt 2 (- (expo x) n)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare-equal)
            :use ((:instance expt-split (r 2) (i 1) (j (- (expo x) n)))
                  (:instance near-a-c-7 (e (expt 2 (- (expo x) n)))))))))

(local
 (defthm near-a-c-9
   (implies (and (rationalp x) (> x 0)
                 (rationalp a) (> a 0)
                 (integerp n) (> n 0)
                 (exactp a n)
                 (< x a)
                 (> x (- a (expt 2 (- (expo x) n)))))
            (> (- a (expt 2 (- (1+ (expo x)) n)))
               0))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance near-a-c-2)
;			(:instance expt-pos (x (expo x)))
                  )))))

(defthm near-a-c
    (implies (and (rationalp x) (> x 0)
		  (rationalp a) (> a 0)
		  (integerp n) (> n 0)
		  (exactp a n)
		  (< x a)
		  (> x (- a (expt 2 (- (expo x) n)))))
	     (>= (near x n) a))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-a-a (a (- a (expt 2 (- (1+ (expo x)) n)))))
			(:instance near-a-c-8)
			(:instance near-a-c-6)
			(:instance near-a-c-4)
			(:instance near-a-c-9)))))




(local
 (defthm near-exact-1
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n)))
	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
	       (and (< f 1) (< 0 f))))
  :rule-classes ()
  :hints (("goal" :in-theory (enable re)
           :use ((:instance fl-def-linear (x (* (expt 2 (1- n)) (sig x))))
			(:instance exactp))))))

(local
 (defthm near-exact-2
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (exactp x (1+ n)))
	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
	       (integerp (* 2 f))))
  :rule-classes ()
  :hints (("goal" :in-theory (enable expt re)
           :use ((:instance exactp (n (1+ n))))))))

(local
 (defthm near-exact-3
    (implies (and (integerp |2F|)
		  (< 0 |2F|)
		  (< |2F| 2))
	     (= |2F| 1))
  :rule-classes ()))

(local
 (defthm near-exact-4
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n)))
	     (= (re (* (expt 2 (1- n)) (sig x)))
		1/2))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-1)
			(:instance near-exact-2)
			(:instance near-exact-3 (|2F| (* 2 (re (* (expt 2 (1- n)) (sig x)))))))))))

(local
 (defthm near-exact-5
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
	     (= (near x n)
		(* (fl (* (expt 2 (1- n)) (sig x)))
		   (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near)
			(:instance near-exact-4)
			(:instance trunc))))))

(local
 (defthm near-exact-6
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
	     (= (* (expt 2 (- (- n 2) (expo x)))
		   (near x n))
		(/ (fl (* (expt 2 (1- n)) (sig x)))
		   2)))
  :rule-classes ()
  :hints (("goal" :in-theory (enable a15)
           :use ((:instance near-exact-5)
			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))

(local
 (defthm near-exact-7
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
	     (integerp (* (expt 2 (- (- n 2) (expo x)))
			  (near x n))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-6)
			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x))))))))))

(local
 (defthm near-exact-8
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
	     (= (expo (near x n)) (expo x)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-4)
			(:instance near)
			(:instance expo-trunc))))))

(local
 (defthm near-exact-9
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
	     (exactp (near x n) (1- n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-7)
			(:instance near-exact-8)
			(:instance near-pos)
			(:instance exactp2 (x (near x n)) (n (1- n))))))))

(local
 (defthm near-exact-10
     (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (= (near x n)
		(* (cg (* (expt 2 (1- n)) (sig x)))
		   (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near)
			(:instance near-exact-4)
			(:instance away))))))

(local
 (defthm near-exact-11
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (= (near x n)
		(* (1+ (fl (* (expt 2 (1- n)) (sig x))))
		   (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (enable re)
           :use ((:instance near-exact-10)
			(:instance near-exact-1)
			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x)))))))))

(local
 (defthm near-exact-12
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (= (* (expt 2 (- (- n 2) (expo x)))
		   (* (1+ (fl (* (expt 2 (1- n)) (sig x))))
		      (expt 2 (- (1+ (expo x)) n))))
		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
		   2)))
  :rule-classes ()
  :hints (("goal" :in-theory (enable a15)
           :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))

(local
 (defthm near-exact-13
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (= (* (expt 2 (- (- n 2) (expo x)))
		   (near x n))
		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
		   2)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-11)
			(:instance near-exact-12))))))

(local
 (defthm near-exact-14
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (integerp (* (expt 2 (- (- n 2) (expo x)))
			  (near x n))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable a9; rearrange-fractional-coefs-equal
                                      distributivity)
		  :use ((:instance near-exact-13)
			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x)))))
			(:instance x-or-x/2 (x (fl (* (expt 2 (1- n)) (sig x))))))))))

(local
 (defthm near-exact-15
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (= (near x n) (expt 2 (1+ (expo x)))))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (= (expo (near x n)) (expo x)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-4)
			(:instance near)
			(:instance away)
;			(:instance away-pos)
			(:instance expo-away))))))

(local
 (defthm near-exact-16
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (= (near x n) (expt 2 (1+ (expo x)))))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (exactp (near x n) (1- n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-14)
			(:instance near-exact-15)
			(:instance near-pos)
			(:instance exactp2 (x (near x n)) (n (1- n))))))))

(local
 (defthm near-exact-17
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (exactp x n))
		  (exactp x (1+ n))
		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
	     (exactp (near x n) (1- n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-16)
			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n))))))))

(defthm near-exact
  (implies (and (rationalp x) (> x 0)
                (integerp n) (> n 1)
                (exactp x (1+ n))
                (not (exactp x n)))
           (exactp (near x n) (1- n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-exact-17)
			(:instance near-exact-9)))))


(local
 (defthm near-est-1
   (implies (and (integerp n) (> n 0)
                 (rationalp x) (> x 0)
                 (> (abs (- x (near x n)))
                    (expt 2 (- (expo x) n))))
            (< (trunc x n)
               (- x (expt 2 (- (expo x) n)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable TRUNC-EXACTP-B REARRANGE-NEGATIVE-COEFS-<)
            :use ((:instance near2 (y (trunc x n)))
                  (:instance trunc-exactp-b)
;			(:instance trunc-pos)
                  (:instance trunc-upper-pos))))))

(local
(defthm near-est-2
    (implies (and (integerp n) (> n 0)
		  (rationalp x) (> x 0)
		  (> (abs (- x (near x n)))
		     (expt 2 (- (expo x) n))))
	     (> (away x n)
		(+ x (expt 2 (- (expo x) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable near-exactp-c)
           :use ((:instance near2 (y (away x n)))
			(:instance away-exactp-b)
;			(:instance away-pos)
			(:instance away-lower-pos))))))

(local
(defthm near-est-3
    (implies (and (integerp n) (> n 0)
		  (rationalp x) (> x 0)
		  (> (abs (- x (near x n)))
		     (expt 2 (- (expo x) n))))
	     (> (away x n)
		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable a15 expt-compare-equal)
		  :use ((:instance near-est-1)
			(:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
			(:instance near-est-2))))))

(local
(defthm near-est-4
    (implies (and (integerp n) (> n 0)
		  (rationalp x) (> x 0)
		  (> (abs (- x (near x n)))
		     (expt 2 (- (expo x) n))))
	     (> x
		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-est-3)
			(:instance fp+2 (x (trunc x n)))
			(:instance trunc-exactp-b)
;			(:instance trunc-pos)
			(:instance expo-trunc)
			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))

(defthm near-est
    (implies (and (integerp n) (> n 0)
		  (rationalp x) (> x 0))
	     (<= (abs (- x (near x n)))
		 (expt 2 (- (expo x) n))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-est-4)
			(:instance trunc-lower-1)
;			(:instance trunc-pos)
                        ))))

(local
(defthm near-power-a-1
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x))))))
	     (= (expo (near x n)) (expo x)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near)
			(:instance away)
;			(:instance away-pos)
			(:instance expo-trunc)
			(:instance expo-away))))))

(local
 (defthm near-power-a-2
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 0)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x))))))
            (< (near x n) (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-power-a-1)
                         (:instance expo-upper-bound (x (near x n)))
                         (:instance near-pos))))))

(local
 (defthm near-power-a-3
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 0)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x))))))
            (<= (+ (near x n) (expt 2 (- (1+ (expo x)) n)))
                (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable EXACTP-2**N-REWRITE EXACTP-2**N)
            :use ((:instance near-power-a-2)
                 (:instance near-power-a-1)
;                 (:instance exactp-near)
                 (:instance fp+1 (x (near x n)) (y (expt 2 (1+ (expo x)))))
                 (:instance exactp-2**n (n (1+ (expo x))) (m n))
                 (:instance near-pos))))))

(local
 (defthm near-power-a-4
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 0)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x))))))
            (<= (+ (- x (expt 2 (- (expo x) n)))
                   (expt 2 (- (1+ (expo x)) n)))
                (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-power-a-3)
                         (:instance near-est))))))

(local
 (defthm near-power-a-5
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 0)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x))))))
            (<= (+ x (expt 2 (- (expo x) n)))
                (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare-equal)
            :use ((:instance near-power-a-4)
                  (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))

(local
(defthm near-power-a-6
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (= (+ x (expt 2 (- (expo x) n)))
		(expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-5))))))

(local
(defthm near-power-a-7
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (= x 
		(- (expt 2 (1+ (expo x)))
		   (expt 2 (- (expo x) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-6))))))

(local
(defthm near-power-a-8
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (integerp (* (- (expt 2 (1+ (expo x)))
			     (expt 2 (- (expo x) n)))
			  (expt 2 (- n (expo x))))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-7)
			(:instance expt-split (r 2) (i (- n (expo x))) (j (1+ (expo x))))
			(:instance expt-split (r 2) (i (- n (expo x))) (j (- (expo x) n))))))))

(local
(defthm hack-90
    (implies (and (= x y)
		  (integerp (* y e)))
	     (integerp (* x e)))
  :rule-classes ()))

(local
(defthm near-power-a-9
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (integerp (* x (expt 2 (- n (expo x))))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-7)
			(:instance hack-90 
				   (y (- (expt 2 (1+ (expo x))) (expt 2 (- (expo x) n))))
				   (e (expt 2 (- n (expo x)))))
			(:instance near-power-a-8))))))

(local
(defthm near-power-a-10
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (exactp x (1+ n)))
  :rule-classes ()
  :hints (("goal" :in-theory (enable exactp2)
		  :use ((:instance near-power-a-9))))))

(local
(defthm near-power-a-11
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (not (exactp x n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-6)
			(:instance expo-upper-bound)
			(:instance fp+1 (y (expt 2 (1+ (expo x)))))
			(:instance exactp-2**n (n (1+ (expo x))) (m n))
			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))

(local
(defthm near-power-a-12
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (not (= (near x n)
			  (expt 2 (1+ (expo x)))))
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (exactp (near x n) (1- n)))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-a-10)
			(:instance near-power-a-11)
			(:instance near-exact))))))

(local
 (defthm near-power-a-13
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x)))))
                 (>= (+ x (expt 2 (- (expo x) n)))
                     (expt 2 (1+ (expo x)))))
            (<= (+ (near x n) (expt 2 (- (+ (expo x) 2) n)))
                (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable exactp-2**n exactp-2**n-rewrite)
            :use ((:instance near-power-a-12)
                  (:instance near-power-a-2)
                  (:instance near-pos)
                  (:instance fp+1 (x (near x n)) (n (1- n)) (y (expt 2 (1+ (expo x)))))
                  (:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
                  (:instance near-power-a-1))))))

(local
 (defthm near-power-a-14
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (not (= (near x n)
                         (expt 2 (1+ (expo x)))))
                 (>= (+ x (expt 2 (- (expo x) n)))
                     (expt 2 (1+ (expo x)))))
            (>= (+ (near x n) (expt 2 (- (+ (expo x) 1) n)))
                (expt 2 (1+ (expo x)))))
   :rule-classes ()
   :hints (("goal" :in-theory (enable expt-split)
            :use ((:instance near-est))))))

(defthm near-power-a
  (implies (and (rationalp x) (> x 0)
                (integerp n) (> n 1)
                (>= (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x)))))
           (= (near x n)
              (expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable expt-compare)
           :use ((:instance near-power-a-13)
                 (:instance near-power-a-14)
                 (:instance expt-strong-monotone
                            (n (- (+ (expo x) 1) n))
                            (m (- (+ (expo x) 2) n)))))))

(local
(defthm near-power-b-1
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
		 (expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance exactp-2**n (n (1+ (expo x))) (m n))
;			(:instance expt-pos (x (- (expo x) n)))
			(:instance trunc-exactp-c 
				   (x (+ x (expt 2 (- (expo x) n))))
				   (a (expt 2 (1+ (expo x))))))))))

(local
(defthm near-power-b-2
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x))))
		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
			  (expt 2 (1+ (expo x))))))
	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
		(expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-power-b-1))))))

(local
(defthm near-power-b-3
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x))))
		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
			  (expt 2 (1+ (expo x))))))
	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
		 (+ (expt 2 (1+ (expo x)))
		    (expt 2 (- (+ 2 (expo x)) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance near-power-b-2)
			(:instance exactp-2**n (n (1+ (expo x))) (m n))
			(:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))))
;			(:instance expt-pos (x (1+ (expo x))))
			(:instance expo-2**n (n (1+ (expo x))))
			(:instance fp+1 
				   (x (expt 2 (1+ (expo x))))
				   (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))

(local
(defthm near-power-b-4
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x))))
		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
			  (expt 2 (1+ (expo x))))))
	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
		(+ x (expt 2 (- (expo x) n)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable expt-compare)
           :use ((:instance near-power-b-3)
			(:instance expo-upper-bound)
			(:instance expt-weak-monotone (n (- (expo x) n)) (m (- (+ 2 (expo x)) n))))))))

(defthm near-power-b
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
		(expt 2 (1+ (expo x)))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance near-power-b-4)
			(:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
;			(:instance expt-pos (x (- (expo x) n)))
                        ))))

(local
 (defthm near-trunc-1
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (>= (+ x (expt 2 (- (expo x) n)))
		      (expt 2 (1+ (expo x)))))
	     (= (near x n)
		(if (and (exactp x (1+ n)) (not (exactp x n)))
		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance near-power-a)
			(:instance near-power-b)
			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
			(:instance trunc-trunc (x (+ x (expt 2 (- (expo x) n)))) (m (1- n)))
			(:instance trunc-exactp-a
				   (x (trunc (+ x (expt 2 (- (expo x) n))) n))
				   (n (1- n)))
;			(:instance expt-pos (x (- (expo x) n)))
                        )))))

(local
 (defthm near-trunc-2
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x)))))
            (= (expo (near x n))
               (expo x)))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-power-a-1)
                         (:instance near-est))))))

(local
 (defthm near-trunc-3
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x)))))
            (= (expo (+ x (expt 2 (- (expo x) n))))
               (expo x)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance expo-unique (x (+ x (expt 2 (- (expo x) n)))) (n (expo x)))
                  (:instance expo-lower-bound)
;			(:instance expt-pos (x (- (expo x) n)))
                  )))))

(local
 (defthm near-trunc-4
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (exactp x n))
            (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
                x))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance trunc-exactp-c
                             (x (+ x (expt 2 (- (expo x) n))))
                             (a x))
;			(:instance expt-pos (x (- (expo x) n)))
                  )))))

(local
 (defthm near-trunc-5
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (exactp x n))
            (<(trunc (+ x (expt 2 (- (expo x) n))) n)
              (fp+ x n)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare
                                       )
            :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
                  (:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n)))
;			(:instance expt-pos (x (- (expo x) n)))
                  )))))

(local
(defthm near-trunc-6
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x n))
	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
		 x))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance near-trunc-5)
			(:instance fp+1 (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
			(:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n)))))
;			(:instance expt-pos (x (- (expo x) n)))
                        )))))

(local
(defthm near-trunc-7
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x n))
	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
		x))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-trunc-4)
			(:instance near-trunc-6))))))

(defthm near-exactp
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 0)
		  (exactp x n))
	     (equal (near x n) x))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-choice)
			(:instance trunc-exactp-a)
			(:instance away-exactp-a)))))
			
(local
 (defthm near-trunc-case-1
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (exactp x n))
            (= (trunc (+ x (expt 2 (- (expo x) n))) n)
               (near x n)))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-trunc-7)
                         (:instance near-exactp)
                         (:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n))))))))))

(local
 (defthm near-trunc-8
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (= (near x n)
                    (- x (expt 2 (- (expo x) n)))))
            (exactp x (1+ n)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;exactp-near
                                       NEAR-EXACTP-D
                                       )
            :use ((:instance near-trunc-2)
                  (:instance near-pos)
;	(:instance exactp-near)
                  (:instance fp+2 (x (near x n)) (n (1+ n)))
                  (:instance exactp-<= (x (near x n)) (m n) (n (1+ n))))))))

(local
 (defthm near-trunc-9
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (not (exactp x (1+ n))))
            (> (near x n)
               (- x (expt 2 (- (expo x) n)))))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-trunc-8)
                         (:instance near-est))))))

(local
 (defthm near-trunc-10
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1))
            (<= (near x n)
                (trunc (+ x (expt 2 (- (expo x) n))) n)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;exactp-near
                                       )
            :use (;(:instance exactp-near)
                  (:instance trunc-exactp-c (x (+ x (expt 2 (- (expo x) n)))) (a (near x n)))
                  (:instance near-est))))))

(local
 (defthm near-trunc-11
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (not (exactp x (1+ n))))
            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
               (+ (near x n)
                  (expt 2 (- (expo x) n))
                  (expt 2 (- (expo x) n)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos
                               )
            :use ((:instance near-trunc-9)
                  (:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
;			(:instance expt-pos (x (- (expo x) n)))
                  )))))

(local
 (defthm near-trunc-12
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (not (exactp x (1+ n))))
            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
               (+ (near x n)
                  (expt 2 (- (1+ (expo x)) n)))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable expt-compare-equal)
            :use ((:instance near-trunc-11)
                         (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))

(local
 (defthm near-trunc-13
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (not (exactp x (1+ n))))
            (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
                (near x n)))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;exactp-near
                                       trunc-exactp-b ;expt-pos
                                       NEAR-EXACTP-D
                                       )
            :use ((:instance near-trunc-12)
                  (:instance fp+1
                             (x (near x n))
                             (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
                  (:instance near-trunc-2)
;			(:instance expt-pos (x (- (expo x) n)))
;                  (:instance exactp-near)
                  (:instance near-pos)
                  (:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n))))))))))

(local
 (defthm near-trunc-case-2
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (not (exactp x (1+ n))))
            (= (near x n)
               (trunc (+ x (expt 2 (- (expo x) n))) n)))
   :rule-classes ()
   :hints (("goal" :use ((:instance near-trunc-10)
                         (:instance near-trunc-13))))))

(local
(defthm near-trunc-14
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n))
		  (> (near x n) x))
	     (= (near x n)
		(+ x (expt 2 (- (expo x) n)))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-est)
;			(:instance exactp-near)
			(:instance exactp-<= (x (near x n)) (m n) (n (1+ n)))
			(:instance fp+1 (n (1+ n)) (y (near x n))))))))

(local
(defthm near-trunc-15
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n))
		  (> (near x n) x))
	     (= (near x n)
		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-trunc-14)
			(:instance near-exact)
			(:instance trunc-exactp-a (x (near x n)) (n (1- n))))))))

(local
(defthm near-trunc-16
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n))
		  (< (near x n) x))
	     (<= (near x n)
		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable ;expt-pos
                              )
		  :use ((:instance near-exact)
;			(:instance expt-pos (x (- (expo x) n)))
			(:instance trunc-exactp-c
				   (x (+ x (expt 2 (- (expo x) n))))
				   (n (1- n))
				   (a (near x n))))))))

(local
(defthm near-trunc-17
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n))
		  (< (near x n) x))
	     (>= (+ (near x n)
		    (expt 2 (- (1+ (expo x)) n)))
		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
  :rule-classes ()
  :hints (("goal" :in-theory (enable expt-split)
                              
		  :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
			(:instance near-est))))))

(local
(defthm near-trunc-18
    (implies (and (rationalp x)
		  (integerp n))
	     (> (+ (near x n)
		   (expt 2 (- (+ 2 (expo x)) n)))
		(+ (near x n)
		   (expt 2 (- (1+ (expo x)) n)))))		 
  :rule-classes ()
  :hints (("goal" :use ((:instance expt-strong-monotone 
				   (n (- (1+ (expo x)) n)) 
				   (m (- (+ 2 (expo x)) n))))))))

(local
 (defthm near-trunc-19
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (exactp x (1+ n))
                 (not (exactp x n))
                 (< (near x n) x))
            (> (+ (near x n)
                  (expt 2 (- (+ 2 (expo x)) n)))
               (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable  expt-compare)
            :use ((:instance near-trunc-17)
                  (:instance near-trunc-18))))))

(local
 (defthm near-trunc-20
   (implies (and (rationalp x) (> x 0)
                 (integerp n) (> n 1)
                 (< (+ x (expt 2 (- (expo x) n)))
                    (expt 2 (1+ (expo x))))
                 (exactp x (1+ n))
                 (not (exactp x n))
                 (< (near x n) x))
            (>= (near x n)
                (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
   :rule-classes ()
   :hints (("goal" :in-theory (disable ;expt-pos 
                               NEAR-EXACTP-D
                               )
            :use ((:instance near-exact)
;			(:instance expt-pos (x (- (expo x) n)))
                  (:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
                  (:instance fp+1 
                             (x (near x n)) 
                             (y (trunc (+ x (expt 2 (- (expo x) n))) (1- n)))
                             (n (1- n)))
                  (:instance near-pos)
                  (:instance near-trunc-19)
                  (:instance near-trunc-2))))))

(local
(defthm near-trunc-21
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n))
		  (< (near x n) x))
	     (= (near x n)
		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-trunc-16)
			(:instance near-trunc-20))))))

(local
 (defthm near-trunc-case-3
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1)
		  (< (+ x (expt 2 (- (expo x) n)))
		     (expt 2 (1+ (expo x))))
		  (exactp x (1+ n))
		  (not (exactp x n)))
	     (= (near x n)
		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
  :rule-classes ()
  :hints (("goal" :in-theory (disable near-exactp-b)
		  :use ((:instance near-trunc-21)
			(:instance near-exactp-b)
			(:instance near-trunc-15))))))

(defthm near-trunc
    (implies (and (rationalp x) (> x 0)
		  (integerp n) (> n 1))
	     (= (near x n)
		(if (and (exactp x (1+ n)) (not (exactp x n)))
		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
  :rule-classes ()
  :hints (("goal" :use ((:instance near-trunc-1)
			(:instance near-trunc-case-1)
			(:instance near-trunc-case-2)
			(:instance near-trunc-case-3)))))

(defthm near-0
  (equal (near 0 n)
         0)
  :hints (("Goal" :in-theory (enable near))))

;BOZO yuck?
(defthm sgn-near
  (implies (and (rationalp x)
                (integerp n)
                (> n 0))
           (= (near x n)
              (* (sgn x) (near (abs x) n))))
  :rule-classes ()
  :hints (("goal" :in-theory (enable abs))))




(defthm plus-near-1
  (implies (and (exactp x (+ k (- (expo x) (expo y))))
                (rationalp x)
                (>= x 0)
                (rationalp y)
                (>= y 0)
                (integerp k)
                )
           (= (re (* (expt 2 (1- k)) (sig y)))
              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
                     (sig (+ x y))))))
  :rule-classes nil
  :hints (("Goal" :in-theory (enable re sig exactp expt-split expt-minus))))

(defthm plus-near-2
  (implies (and (rationalp x)
                (>= x 0)
                (rationalp y)
                (>= y 0)
                (integerp k)
                (exactp x (+ -1 k (- (expo x) (expo y)))))
           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
                (evenp (fl (* (expt 2
                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
                              (sig (+ x y)))))))
  :otf-flg t
  :rule-classes nil 
  :hints (("Goal" :in-theory (e/d (expt-split
                                   expt-minus
                                   exactp sig ; EXPT-SPLIT-leading-constant
                                   evenp ;this is sort of cheating...
                                   ) ())
           :use ((:instance exactp2 (n (+ k (expo x) (- (expo y)))))
                 (:instance exactp-<=
                            (m (+ -1 k (expo x) (- (expo y))))
                            (n (+ k (expo x) (- (expo y)))))))))

(defthm plus-near
  (implies (and (rationalp x)
                (>= x 0)
                (rationalp y)
                (>= y 0)
                (integerp k)
                (exactp x (+ -1 k (- (expo x) (expo y)))))
           (= (+ x (near y k))
              (near (+ x y)
                    (+ k (- (expo (+ x y)) (expo y))))))
  :rule-classes nil
  :hints (("Goal" :in-theory (enable near)
           :use (plus-trunc plus-away plus-near-1 plus-near-2
                            (:instance exactp-<=
                                       (m (+ -1 k (expo x) (* -1 (expo y))))
                                       (n (+ k (expo x) (* -1 (expo y)))))))))



