(in-package "ACL2")

(include-book "merge") ;try removing?
(include-book "land")
(include-book "lior")
(include-book "lxor")

(local (include-book "../arithmetic/top"))
(local (include-book "bvecp"))
(local (include-book "bits"))
(local (include-book "bitn"))
(local (include-book "lnot"))


(local (in-theory (disable fl-def-linear; mod-equal
                           )))

;(local (in-theory (enable expt-inverse))) ;BOZO

(defund sigm (a b c n)
  (if (= c 0)
      (lnot (lxor a b n) n)
    (lxor a b n)))

(defund KAP (a b c n)
  (if (= c 0)
      (* 2 (lior a b n))
    (* 2 (land a b n))))

;why n+1 instead of n twice below?
(defund TAU (a b c n)
  (lnot (lxor (sigm a b c n) (kap a b c n) (1+ n)) (1+ n)))

(defthm bvecp-sigm
  (bvecp (sigm a b c n) n)
  :hints (("Goal" :in-theory (enable sigm)))
  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm a b c n)))))

(defthm bvecp-kap
    (implies (and (integerp n)
                  (<= 0 n)
                  )
	     (bvecp (kap a b c n) (1+ n)))
  :hints (("Goal" :in-theory (enable kap)))
  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap a b c n)))))

(defthm bvecp-tau
  (bvecp (tau a b c n) (1+ n))
  :hints (("Goal" :in-theory (enable tau)))
  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau a b c n)))))


(defthm SIGM-BNDS
  (implies (and (integerp n)
                (>= n 0)
                )
           (and (integerp (sigm a b c n))
                (>= (sigm a b c n) 0)
                (< (sigm a b c n) (expt 2 n))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable sigm))))


(defthm KAP-BNDS
  (implies (and (integerp n)
                (>= n 0)
                )
           (and (integerp (kap a b c n))
                (>= (kap a b c n) 0)
                (< (kap a b c n) (expt 2 (1+ n)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable kap expt-split ))))

(defthm TAU-BNDS
    (implies (and (integerp n)
		  (>= n 0)
                  )
	     (and (integerp (tau a b c n))
		  (>= (tau a b c n) 0)
		  (< (tau a b c n) (expt 2 (1+ n)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable tau))))



(local (defthm top-1
         (implies (and (integerp n)
                       (>= n 0)
                       (integerp k)
                       (>= k 0)
                       (<= k n)
;(or (equal c 0) (equal c 1))
                       )
                  (not (equal (bitn (tau a b c n) k)
                              (bitn (lxor (sigm a b c n) (kap a b c n) (+ 1 n)) k))))
         :rule-classes ()
         :hints (("Goal" :in-theory (enable tau)
		  :use (sigm-bnds
			kap-bnds
			(:instance bitn-lnot-not-equal (x (lxor (sigm a b c n) (kap a b c n) (+ 1 n))) (n (1+ n)))
;			(:instance logxor<2**n (x (osigm a b c n)) (y (okap a b c)) (n (1+ n)))
;			(:instance logxor-nat (i (osigm a b c n)) (j (okap a b c)))
                        )))))

(local (in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)))

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

                       (integerp k)
                       (>= k 0)
                       (<= k n)
                       )
                  (iff (equal (bitn (lxor (sigm a b c n) (kap a b c n) (+ 1 n)) k)
                              (bitn (sigm a b c n) k))
                       (equal (bitn (kap a b c n) k)
                              0)))
         :rule-classes ()
         :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
		  :use (sigm-bnds
			kap-bnds
			(:instance bitn-0-1 (x (sigm a b c n)) (n k))
			(:instance bitn-0-1 (x (kap a b c n)) (n k))
;			(:instance bitn-logxor (x (osigm a b c n)) (y (okap a b c)) (n k))
                        )))))

(local (defthm top-3
         (implies (and (integerp n)
                       (>= n 0)
                       (integerp k)
                       (>= k 0)
                       (<= k n)
                       )
                  (iff (equal (bitn (tau a b c n) k)
                              (bitn (sigm a b c n) k))
                       (equal (bitn (kap a b c n) k)
                              1)))
         :rule-classes ()
         :hints (("Goal" ; :in-theory (disable)
		  :use (top-1
			top-2
			(:instance bitn-0-1 (x (sigm a b c n)) (n k))
			(:instance bitn-0-1 (x (lxor (sigm a b c n) (kap a b c n) (+ 1 n))) (n k))
			(:instance bitn-0-1 (x (kap a b c n)) (n k))
			(:instance bitn-0-1 (x (tau a b c n)) (n k)))))))

(local (defthm top-4
         (equal (bitn (kap a b c n) 0)
                0)
         :rule-classes ()
         :hints (("Goal" :in-theory (enable kap)
                  :use ((:instance bitn-plus-mult (x 0) (k (lior a b n)) (m 1) (n 0))
                        (:instance bitn-plus-mult (x 0) (k (land a b n)) (m 1) (n 0))
                        )))))

(local (defthm top-5
         (implies (and (integerp n)
                       (>= n 0)
                       )
                  (not (equal (bitn (tau a b c n) 0)
                              (bitn (sigm a b c n) 0))))
         :rule-classes ()
         :hints (("Goal" ; :in-theory (disable lnot tau sigm kap)
		  :use (top-4
			(:instance top-3 (k 0)))))))
(local (defthm top-7
    (IMPLIES (AND (INTEGERP N)
		  (< 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
                  )
	     (IFF (equal (bitn (+ A B) 0) 0)
		  (equal (bitn (TAU A B 0 N) 0) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (e/d (sigm) ())
		  :use ( (:instance bitn-lxor-0 (x a) (y b))
			(:instance top-5 (c 0))
;			(:instance logxor-nat (i a) (j b))
;			(:instance logxor<2**n (x a) (y b))
			(:instance bitn-lnot-not-equal (k 0) (x (logxor a b n)))
			(:instance bitn-0-1 (x (tau a b 0 n)) (n 0))
			(:instance bitn-0-1 (x (sigm a b 0 n)) (n 0))
			(:instance bitn-0-1 (x (lxor a b n)) (n 0)))))))

(local (defthm top-8
    (IMPLIES (AND (INTEGERP N)
		  (< 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
                  )
	     (IFF (equal (mod (+ A B) 2) 0)
		  (equal (mod (TAU A B 0 N) 2) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (set-difference-theories
                              (enable bitn-def)
                              '())
		  :use (top-7
			(:instance tau-bnds (c 0)))))))

(local
 (defthm top-9
   (implies (and (integerp a)
                 (integerp b)
                 (integerp n)
                 (<= 1 n)
                 )
            (not (equal (bitn (+ a b 1) 0)
                        (bitn (lxor a b n) 0))))
   :rule-classes ()
   :hints (("Goal" :use ((:instance bitn-0-1 (x a) (n 0))
                         (:instance bitn-0-1 (x b) (n 0))

                         (:instance bitn-logxor-0)
                         (:instance bitn-logxor-0 (a (+ 1 a)))
                         (:instance bitn-logxor-0 (b 1))
                         (:instance mod-mod-2-not-equal (x (+ a b))))))))


(local (defthm top-10
    (IMPLIES (AND (INTEGERP N)
		  (< 0 N)
		  (INTEGERP A)

		  (INTEGERP B)
		  )
	     (IFF (equal (bitn (+ A B 1) 0) 0)
		  (equal (bitn (TAU A B 1 N) 0) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bitn-negative-bit-of-integer sigm kap)
		  :use (top-9
			(:instance top-5 (c 1))
;			(:instance logxor-nat (i a) (j b))
;			(:instance logxor<2**n (x a) (y b))
			(:instance bitn-0-1 (x (tau a b 1 n)) (n 0))
			(:instance bitn-0-1 (x (sigm a b 1 n)) (n 0))
			(:instance bitn-0-1 (x (+ a b 1)) (n 0)))))))

(local (defthm top-11
    (IMPLIES (AND (INTEGERP N)
		  (< 0 N)
		  (INTEGERP A)

		  (INTEGERP B)
)
	     (IFF (equal (mod (+ A B 1) 2) 0)
		  (equal (mod (TAU A B 1 N) 2) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (set-difference-theories
                              (enable bitn-def)
                              '())
		  :use (top-10
			(:instance tau-bnds (c 1)))))))

(local (defthm top-12
    (IMPLIES (AND (INTEGERP N)
		  (< 0 N)
		  (INTEGERP A)

		  (INTEGERP B)

		  (OR (equal C 0) (equal C 1)))
	     (IFF (equal (MOD (+ A B C) 2) 0)
		  (equal (MOD (TAU A B C N) 2) 0)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (top-11 top-8)))))

(local (defthm top-13
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (IMPLIES (AND (INTEGERP N)
				(<= 0 N)
				(INTEGERP A)
				(INTEGERP B)
				(INTEGERP (+ -1 K))
				(<= 0 (+ -1 K))
				(< (+ -1 K) N)
				(OR (equal C 0) (equal C 1)))
			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
				(equal (MOD (TAU A B C N) (EXPT 2 k)) 0)))
		  (not (and (equal (MOD (+ A B C) (EXPT 2 k))  0)
			    (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)))
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1)))
	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
		  (equal (MOD (TAU A B C N) (EXPT 2 (+ 1 K)))
		     0)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (tau-bnds
			(:instance mod-n-n+1 (a (tau a b c n)) (n k))
			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))

(local (defthm top-14
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (equal (bitn (+ a b c) k) (bitn (tau a b c n) k))
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)

		  (INTEGERP B)

		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1)))
	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
		  (equal (MOD (TAU A B C N) (EXPT 2 (+ 1 K)))
		     0)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (tau-bnds
			(:instance mod-n-n+1 (a (tau a b c n)) (n k))
			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))

;move?
(local (defthm top-15
         (implies (and ;(integerp a)
                       ;(>= a 0)
                       (integerp k)
                       (>= k 0))
                  (equal (fl (/ a (expt 2 k)))
                         (+ (* 2 (fl (/ a (expt 2 (1+ k)))))
                            (bitn a k))))
         :rule-classes ()
         :hints (("Goal" :in-theory (e/d ( bitn-def expt) (fl/int-rewrite))
		  :use ((:instance quot-mod (m (fl (/ a (expt 2 k)))) (n 2))
			(:instance fl/int-rewrite (x (/ a (expt 2 k))) (n 2))
                        )))))

;move?
(local (defthm top-16-1
    (implies (and ;(integerp a)
		  ;(>= a 0)
		  (integerp k)
		  (>= k 0))
	     (equal (/ a (expt 2 k))
		    (/ (+ (* (expt 2 k) (fl (/ a (expt 2 k))))
			  (mod a (expt 2 k)))
		       (expt 2 k))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance quot-mod (m a) (n (expt 2 k)))
			)))))

;move?
(local (defthm top-16-2
    (implies (and ;(integerp a)
		  ;(>= a 0)
		  (integerp k)
		  (>= k 0))
	     (equal (/ a (expt 2 k))
		    (+ (/ (* (expt 2 k) (fl (/ a (expt 2 k)))) (expt 2 k))
		       (/ (mod a (expt 2 k)) (expt 2 k)))))
  :rule-classes ()
  :hints (("Goal" :use (top-16-1)))))

;move?
(local (defthm top-16
    (implies (and ;(integerp a)
		  ;(>= a 0)
		  (integerp k)
		  (>= k 0))
	     (equal (/ a (expt 2 k))
		    (+ (fl (/ a (expt 2 k)))
		       (/ (mod a (expt 2 k)) (expt 2 k)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable a15)
           :use (top-16-2)))))

;move?
(local (defthm top-17
    (implies (and ;(integerp a)
		  ;(>= a 0)
		  (integerp k)
		  (>= k 0))
	     (equal (/ a (expt 2 k))
		(+ (* 2 (fl (/ a (expt 2 (1+ k)))))
		   (bitn a k)
		   (/ (mod a (expt 2 k)) (expt 2 k)))))
  :rule-classes ()
  :hints (("Goal" :use (top-15
			top-16
)))))

(local
 (defthm top-18
   (IMPLIES (AND (INTEGERP K)
                 (< 0 K)
                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
                 (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
                 (INTEGERP N)
                 (<= 0 N)
                 (INTEGERP A)
;		  (<= 0 A)
;	  (< A (EXPT 2 N))
                 (INTEGERP B)
;  (<= 0 B)
; (< B (EXPT 2 N))
                 (INTEGERP K)
                 (<= 0 K)
                 (< K N)
;(OR (equal C 0) (equal C 1))
                 )
            (equal (/ (+ a b c) (expt 2 k))
                   (+ (bitn a k)
                      (bitn b k)
                      (* 2 (fl (/ a (expt 2 (1+ k)))))
                      (* 2 (fl (/ b (expt 2 (1+ k)))))
                      (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
                         (expt 2 k)))))
   :rule-classes ()
   :hints (("Goal" :use ((:instance top-17)
                         (:instance top-17 (a b)))))))

(local
 (defthm top-19
   (IMPLIES (AND (INTEGERP K)
                 (< 0 K)
                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
                 (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
                 (INTEGERP N)
                 (<= 0 N)
                 (INTEGERP A)
;                 (<= 0 A)
 ;                (< A (EXPT 2 N))
                 (INTEGERP B)
  ;               (<= 0 B)
   ;              (< B (EXPT 2 N))
                 (INTEGERP K)
                 (<= 0 K)
                 (< K N)
                 (rationalp c);                 (OR (equal C 0) (equal C 1))
                 )
            (equal (fl (/ (+ a b c) (expt 2 k)))
               (+ (bitn a k)
                  (bitn b k)
                  (* 2 (fl (/ a (expt 2 (1+ k)))))
                  (* 2 (fl (/ b (expt 2 (1+ k)))))
                  (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
                         (expt 2 k))))))
   :rule-classes ()
   :hints (("Goal" :in-theory (e/d (expt-inverse
                                    ;expt-split
                                    ;expt-minus
                                    ) ( fl+int-rewrite expo-shift-general))
            :use ((:instance top-18)
                  (:instance fl+int-rewrite
                             (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
                                   (expt 2 k)))
                             (n (+ (bitn a k)
                                   (bitn b k)
                                   (* 2 (fl (/ a (expt 2 (1+ k)))))
                                   (* 2 (fl (/ b (expt 2 (1+ k)))))))))))))
;slow!
;drop?
(local (defthm top-20
    (IMPLIES (AND (INTEGERP K)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
                  )
	     (equal (mod (+ (bitn a k)
			(bitn b k)
			(* 2 (fl (/ a (expt 2 (1+ k)))))
			(* 2 (fl (/ b (expt 2 (1+ k)))))
			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			       (expt 2 k))))
		     2)
		(mod (+ (bitn a k)
			(bitn b k)
			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			       (expt 2 k))))
		     2)))
    :hints (("Goal" :in-theory (disable MOD-DOES-NOTHING ;the disables are just for efficiency
                                        FL-DEF-LINEAR-PART-2
                                        FL-DEF-LINEAR-PART-1
                                        ;MOD-EQUAL
                                        MOD-QUOTIENT-INTEGERP
                                        MOD-BND-1)))
    :rule-classes ()))

(local (defthm top-21
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (rationalp c) ;(OR (equal C 0) (equal C 1))
                  )
	     (equal (mod (fl (/ (+ a b c) (expt 2 k))) 2)
		(mod (+ (bitn a k)
			(bitn b k)
			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			       (expt 2 k))))
		     2)))
  :rule-classes ()
  :hints (("Goal" :hands-off (mod bitn fl expt)
		  :use (top-19 top-20)))))

;move?
(local (defthm top-23
    (implies (and; (integerp a)
;		  (integerp b)
		  (integerp k)
;		  (>= a 0)
	;	  (>= b 0)
		  (>= k 0)
                  (integerp n)
                  (<= 0 n)
                  (< k n)
                  )
	     (equal (bitn (lxor a b n) k)
		(mod (+ (bitn a k) (bitn b k)) 2)))
  :rule-classes ()
  :hints (("Goal" :use (;(:instance bitn-logxor (x a) (y b) (n k))
			(:instance bitn-0-1 (x a) (n k))
			(:instance bitn-0-1 (x b) (n k)))))))

(local (defthm top-22
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (rationalp c) ;(OR (equal C 0) (equal C 1))
                  )
	     (equal (bitn (+ a b c) k)
		(mod (+ (bitn a k)
			(bitn b k)
			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			       (expt 2 k))))
		     2)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bitn-def)
		  :use (top-21)))))



(local (defthm top-24
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (rationalp c) ;(OR (equal C 0) (equal C 1))
                  )
	     (iff (equal (bitn (+ a b c) k)
		     (mod (+ (bitn a k) (bitn b k)) 2))
		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
				 (expt 2 k)))
			  2)
		     0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (disable INTEGERP-PROD ;some of the disables are for efficiency
                                      BITN-UPPER-BOUND-LINEAR
                                      BITN-IN-SUM-SPLIT-CASES
                                      ;BITN-NONNEGATIVE-INTEGER-TYPE
                                      BITN-<=-1
                                      MOD-QUOTIENT-INTEGERP
                                      FL-DEF-LINEAR-PART-1
                                      FL-DEF-LINEAR-PART-2
                                      ;MOD-EQUAL
                                      FL-NON-NEGATIVE-LINEAR
                                      NONNEG-+-TYPE
                                      )
           :use (top-22)))))

(local (defthm top-25
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (rationalp c);(OR (equal C 0) (equal C 1))
                  )
	     (iff (equal (bitn (+ a b c) k)
		     (bitn (lxor a b n) k))
		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
				 (expt 2 k)))
			  2)
		     0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (e/d (;expt-inverse
                                   expt-minus
                                   expt-split
                                   ) (;expo-shift-general
                                      ))
           :use (top-24 top-23)))))

(local (defthm top-26
    (implies (and (integerp a)
		  (integerp b)
		  (integerp k)
		  (>= k 0)
		  (or (equal c 0) (equal c 1)))
	     (< (+ (mod a (expt 2 k))
		   (mod b (expt 2 k))
		   c)
		(expt 2 (1+ k))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable  expt-split)
           :use ()))))

(local (defthm top-27
    (implies (and (integerp a)
;		  (>= a 0)
		  (integerp b)
	;	  (>= b 0)
		  (integerp k)
		  (>= k 0)
		  (or (equal c 0) (equal c 1)))
	     (< (/ (+ (mod a (expt 2 k))
		      (mod b (expt 2 k))
		      c)
		   (expt 2 k))
		2))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable  a15)
           :use (top-26
			(:instance *-strongly-monotonic
				   (x (expt 2 (- k)))
				   (y (+ (mod a (expt 2 k))
					 (mod b (expt 2 k))
					 c))
				   (y+ (expt 2 (1+ k)))))))))

(local (defthm top-28
    (implies (and (integerp a)
;		  (>= a 0)
		  (integerp b)
	;	  (>= b 0)
		  (integerp k)
		  (>= k 0)
		  (or (equal c 0) (equal c 1)))
	     (< (fl (/ (+ (mod a (expt 2 k))
			  (mod b (expt 2 k))
			  c)
		       (expt 2 k)))
		2))
  :rule-classes ()
  :hints (("Goal" :use (top-27
			(:instance fl-def-linear (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))

(local (defthm top-29
    (implies (and (integerp a)
;		  (>= a 0)
		  (integerp b)
	;	  (>= b 0)
		  (integerp k)
		  (>= k 0)
		  (or (equal c 0) (equal c 1)))
	     (>= (fl (/ (+ (mod a (expt 2 k))
			   (mod b (expt 2 k))
			   c)
			(expt 2 k)))
		 0))
  :rule-classes ()
  :hints (("Goal" :use ((:instance n<=fl-linear
				   (n 0)
				   (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
;			(:instance mod>=0 (m a) (n (expt 2 k)))
	;		(:instance mod>=0 (m b) (n (expt 2 k)))
                        )))))

(local (defthm top-30
    (implies (and (integerp a)
;		  (>= a 0)
		  (integerp b)
	;	  (>= b 0)
		  (integerp k)
		  (>= k 0)
		  (or (equal c 0) (equal c 1))
                  )
	     (equal (mod (fl (/ (+ (mod a (expt 2 k))
			       (mod b (expt 2 k))
			       c)
			    (expt 2 k)))
		     2)
		(fl (/ (+ (mod a (expt 2 k))
			  (mod b (expt 2 k))
			  c)
		       (expt 2 k)))))
  :rule-classes ()
  :hints (("Goal" :use (top-28
			top-29
			(:instance mod-does-nothing
				   (x (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
				   (y 2)))))))

(local (defthm top-31
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
		  ;(< A (EXPT 2 N))
		  (INTEGERP B)
	;	  (<= 0 B)
		  ;(< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1))
                  )
	     (iff (equal (bitn (+ a b c) k)
		     (bitn (lxor a b n) k))
		  (equal (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			    (expt 2 k)))
		     0)))
  :rule-classes ()
  :hints (("Goal"  :in-theory (e/d (;expt-inverse
                                    )
                                   ;; MattK: The following disable is needed by
                                   ;; v2-8-alpha-12-30-03.  I didn't
                                   ;; investigate why.
                                   (FL-INTEGER-TYPE))
           :use (top-25 top-30)))))

(local (defthm top-32
    (implies (and (rationalp x)
		  (>= (fl x) 0))
	     (iff (equal (fl x) 0) (< x 1)))
  :rule-classes ()
  :hints (("Goal" :use ((:instance fl-unique (n 0))
			(:instance fl-def-linear))))))

(local (defthm top-33
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1)))
	     (iff (equal (bitn (+ a b c) k)
		     (bitn (lxor a b n) k))
		  (< (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
			(expt 2 k))
		     1)))
  :rule-classes ()
  :hints (("Goal" :use (top-31
			top-29
			(:instance top-32 (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))

(local (defthm top-34
         (IMPLIES (AND (INTEGERP K)
                       (< 0 K)
                       (equal (MOD (+ A B C) (EXPT 2 k))  0)
                       (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
                       (INTEGERP N)
                       (<= 0 N)
                       (INTEGERP A)
;	  (<= 0 A)
;		  (< A (EXPT 2 N))
                       (INTEGERP B)
;  (<= 0 B)
; (< B (EXPT 2 N))
                       (INTEGERP K)
                       (<= 0 K)
                       (< K N)
                       (OR (equal C 0) (equal C 1)))
                  (iff (equal (bitn (+ a b c) k)
                              (bitn (lxor a b n) k))
                       (< (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
                          (expt 2 k))))
         :rule-classes ()
         :hints (("Goal" :in-theory (enable a15)
                  :use (top-33
			(:instance *-strongly-monotonic
				   (x (expt 2 (- k)))
				   (y (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c))
				   (y+ (expt 2 k)))
			(:instance *-strongly-monotonic
				   (x (expt 2 k))
				   (y (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
					 (expt 2 k)))
				   (y+ 1)))))))

(local (defthm top-35
         (implies (and (integerp n)
                       (>= n 0)
                       (integerp a)
;		  (>= a 0)
;	  (< a (expt 2 n))
                       (integerp b)
;  (>= b 0)
; (< b (expt 2 n))
                       (integerp k)
                       (> k 0)
                       (<= k n))
                  (iff (equal (bitn (kap a b 0 n) k) 0)
                       (and (equal (bitn a (1- k)) 0)
                            (equal (bitn b (1- k)) 0))))
         :rule-classes ()
         :hints (("Goal" :in-theory (enable kap)
                  :use ((:instance bitn-shift (k 1) (n (1- k)) (x (logior a b)))
			(:instance bitn-0-1 (x a) (n (1- k)))
			(:instance bitn-0-1 (x b) (n (1- k)))
;			(:instance bit-dist-b (x a) (y b) (n (1- k)))
                        )))))

(local (defthm top-36
         (implies (and (rationalp a) ;(integerp a)
;(>= a 0)
                       (integerp k)
                       (> k 0))
                  (iff (equal (bitn a (1- k)) 0)
                       (< (mod a (expt 2 k)) (expt 2 (1- k)))))
         :rule-classes ()
         :hints (("Goal" :in-theory (enable bitn-mod)
                  :use ( ;(:instance bitn-mod (x a) (n k) (k (1- k)))
;			(:instance mod>=0 (m a) (n (expt 2 k)))
			(:instance mod-bnd-1 (m a) (n (expt 2 k)))
			(:instance bit-expo-a (x (mod a (expt 2 k))) (n (1- k)))
			(:instance bit-expo-b (x (mod a (expt 2 k))) (n (1- k))))))))

(local (defthm top-37
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n)
		  (equal (bitn (kap a b 0 n) k) 0))
	     (< (+ (mod a (expt 2 k))
		   (mod b (expt 2 k)))
		(expt 2 k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable expt-split)
           :use (top-35
                 top-36
                 (:instance top-36 (a b)))))))

(local (defthm top-38
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n)
		  (not (equal (bitn (kap a b 0 n) k) 0)))
	     (>= (+ (mod a (expt 2 k))
		    (mod b (expt 2 k)))
		 (expt 2 (1- k))))
  :rule-classes ()
  :hints (("Goal" :use (top-35
			top-36
			(:instance top-36 (a b))
;			(:instance mod>=0 (m a) (n (expt 2 k)))
	;		(:instance mod>=0 (m b) (n (expt 2 k)))
                        )))))

(local (defthm top-39
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
		  (equal (mod (+ a b) (expt 2 k)) 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n)
		  (not (equal (bitn (kap a b 0 n) k) 0)))
	     (>= (+ (mod a (expt 2 k))
		    (mod b (expt 2 k)))
		 (expt 2 k)))
  :rule-classes ()
  :hints (("Goal" :use (top-38
			(:instance mod-sum (n (expt 2 k)))
;			(:instance mod>=0 (m a) (n (expt 2 k)))
	;		(:instance mod>=0 (m b) (n (expt 2 k)))
			(:instance mod-sum (a (mod b (expt 2 k))) (b a) (n (expt 2 k)))
			(:instance mod-does-nothing (x (+ (mod a (expt 2 k)) (mod b (expt 2 k))))
                                   (y (expt 2 k))))))))

(local (defthm top-40
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
		  (equal (mod (+ a b) (expt 2 k)) 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n))
	     (iff (equal (bitn (kap a b 0 n) k) 0)
		  (< (+ (mod a (expt 2 k))
			(mod b (expt 2 k)))
		     (expt 2 k))))
  :rule-classes ()
  :hints (("Goal" :use (top-39 top-37)))))

(local (defthm top-41
         (IMPLIES (AND (INTEGERP K)
                       (< 0 K)
                       (equal (MOD (+ A B) (EXPT 2 k))  0)
                       (equal (MOD (TAU A B 0 N) (EXPT 2 k)) 0)
                       (INTEGERP N)
                       (<= 0 N)
                       (INTEGERP A)
;		  (<= 0 A)
;	  (< A (EXPT 2 N))
                       (INTEGERP B)
; (<= 0 B)
;  (< B (EXPT 2 N))
                       (INTEGERP K)
                       (<= 0 K)
                       (< K N))
                  (iff (equal (bitn (+ a b) k)
                              (bitn (lxor a b n) k))
                       (equal (bitn (kap a b 0 n) k)
                              0)))
         :rule-classes ()
         :hints (("Goal" :use ((:instance top-34 (c 0)) top-40)))))

(local (defthm top-42
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B 0 N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
		  (INTEGERP B)
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N))
	     (equal (bitn (+ a b) k) (bitn (tau a b 0 n) k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (e/d (sigm) ())
		  :use (top-41
			(:instance top-3 (c 0))
			(:instance bitn-0-1 (x (kap a b 0 n)) (n k))
			(:instance bitn-0-1 (x (lxor a b n)) (n k))
			(:instance bitn-0-1 (x (sigm a b 0 n)) (n k))
			(:instance bitn-0-1 (x (tau a b 0 n)) (n k))
			(:instance bitn-0-1 (x (+ a b)) (n k))
			(:instance bitn-lnot-not-equal (x (lxor a b n)))
;			(:instance logxor<2**n (x a) (y b))
;			(:instance logxor-nat (i a) (j b))
                        )))))

(local
 (defthm top-43
   (IMPLIES (AND (INTEGERP K)
                 (< 0 K)
                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
                 (equal (MOD (TAU A B 1 N) (EXPT 2 k)) 0)
                 (INTEGERP N)
                 (<= 0 N)
                 (INTEGERP A)
;		  (<= 0 A)
;	  (< A (EXPT 2 N))
                 (INTEGERP B)
;  (<= 0 B)
; (< B (EXPT 2 N))
                 (INTEGERP K)
                 (<= 0 K)
                 (< K N))
            (equal (+ (mod a (expt 2 k))
                      (mod b (expt 2 k))
                      1)
                   (expt 2 k)))
   :rule-classes ()
   :hints (("Goal" :in-theory (disable MOD-SUMS-CANCEL-1)
            :use ((:instance top-26 (c 1))
                  (:instance mod-must-be-n
                             (m (+ (mod a (expt 2 k)) (mod b (expt 2 k)) 1))
                             (n (expt 2 k)))
;			(:instance mod>=0 (n (expt 2 k)) (m a))
;		(:instance mod>=0 (n (expt 2 k)) (m b))
                  (:instance mod-sum (n (expt 2 k)) (a (+ (mod a (expt 2 k)) 1)))
                  (:instance mod-sum (n (expt 2 k)) (a (+ b 1)) (b a)))))))

(local
 (defthm top-44
   (IMPLIES (AND (INTEGERP K)
                 (< 0 K)
                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
                 (equal (MOD (TAU A B 1 N) (EXPT 2 k)) 0)
                 (INTEGERP N)
                 (<= 0 N)
                 (INTEGERP A)
                 (INTEGERP B)
                 (INTEGERP K)
                 (<= 0 K)
                 (< K N))
            (not (equal (bitn (+ a b 1) k)
                        (bitn (lxor a b n) k))))
   :rule-classes ()
   :hints (("Goal"; :in-theory (disable tau)
            :use (top-43
                  (:instance top-34 (c 1)))))))

(local (defthm top-45
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n))
	     (iff (equal (bitn (kap a b 1 n) k) 1)
		  (and (equal (bitn a (1- k)) 1)
		       (equal (bitn b (1- k)) 1))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable kap)
           :use ((:instance bitn-shift (k 1) (n (1- k)) (x (land a b n)))
			(:instance bitn-0-1 (x a) (n (1- k)))
			(:instance bitn-0-1 (x b) (n (1- k)))
                        )))))

(local (defthm top-46
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (> k 0)
		  (<= k n)
		  (equal (bitn (kap a b 1 n) k) 1))
	     (>= (+ (mod a (expt 2 k))
		    (mod b (expt 2 k)))
		 (expt 2 k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable expt-split)
           :use (top-45
			top-36
			(:instance top-36 (a b)))))))

(local (defthm top-47
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B 1 N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N))
	     (equal (bitn (kap a b 1 n) k) 0))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (top-46
			top-43
			(:instance bitn-0-1 (x (kap a b 1 n)) (n k)))))))

(local (defthm top-48
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B 1 N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N))
	     (equal (bitn (+ a b 1) k) (bitn (tau a b 1 n) k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (e/d ( sigm) ())
		  :use (top-47
			top-44
			(:instance top-3 (c 1))
			(:instance bitn-0-1 (x (lxor a b n)) (n k))
			(:instance bitn-0-1 (x (sigm a b 1 n)) (n k))
			(:instance bitn-0-1 (x (tau a b 1 n)) (n k))
			(:instance bitn-0-1 (x (+ a b 1)) (n k)))))))

(local (defthm top-49
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
		  (equal (MOD (TAU A B C N) (EXPT 2 k)) 0)
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1)))
	     (equal (bitn (+ a b c) k) (bitn (tau a b c n) k)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (top-48 top-42)))))

(local (defthm top-50
    (IMPLIES (AND (INTEGERP K)
		  (< 0 K)
		  (IMPLIES (AND (INTEGERP N)
				(<= 0 N)
				(INTEGERP A)
			;	(<= 0 A)
				;(< A (EXPT 2 N))
				(INTEGERP B)
				;(<= 0 B)
				;(< B (EXPT 2 N))
				(INTEGERP (+ -1 K))
				(<= 0 (+ -1 K))
				(< (+ -1 K) N)
				(OR (equal C 0) (equal C 1)))
			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
				(equal (MOD (TAU A B C N) (EXPT 2 k)) 0)))
		  (INTEGERP N)
		  (<= 0 N)
		  (INTEGERP A)
;		  (<= 0 A)
	;	  (< A (EXPT 2 N))
		  (INTEGERP B)
		;  (<= 0 B)
		 ; (< B (EXPT 2 N))
		  (INTEGERP K)
		  (<= 0 K)
		  (< K N)
		  (OR (equal C 0) (equal C 1)))
	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
		  (equal (MOD (TAU A B C N) (EXPT 2 (+ 1 K)))
		     0)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :use (top-13 top-14 top-49)))))

;local?
(defthm STICK-LEMMA
    (implies (and (integerp n)
		  (>= n 0)
		  (integerp a)
;		  (>= a 0)
	;	  (< a (expt 2 n))
		  (integerp b)
		;  (>= b 0)
		 ; (< b (expt 2 n))
		  (integerp k)
		  (>= k 0)
		  (< k n)
		  (or (equal c 0) (equal c 1)))
	     (iff (equal (mod (+ a b c) (expt 2 (1+ k))) 0)
		  (equal (mod (tau a b c n) (expt 2 (1+ k))) 0)))
  :rule-classes ()
  :hints (("Goal"; :in-theory (disable tau)
		  :induct (natp-induct k))
	  ("Subgoal *1/2"; :in-theory (disable tau)
			  :use (top-50))
	  ("Subgoal *1/1" :use (top-12))))


(defthm top-thm-2-old
  (implies (and (natp n)
                (integerp a) ;		  (bvecp a n)
                (integerp b) ;(bvecp b n)
                (natp k)
                (< k n)
                (or (equal c 0) (equal c 1)))
           (equal (equal (bits (+ a b c) k 0) 0)
                  (equal (bits (tau a b c n) k 0) 0)))
  :rule-classes ()
  :hints (("Goal" :use (stick-lemma
                 (:instance bits-mod (x (+ a b c)) (i k))
                 (:instance bits-mod (x (tau a b c n)) (i k))))))


;BOZO prove a bits thm to make this go through
(local (defthm stick-lemma-3-1
    (implies (and (integerp a);(natp a)
		  (integerp b);(natp b)
                  (integerp k)
;		  (natp k)
                  )
	     (equal (bits (+ a b 1) k 0)
		    (bits (+ (bits a k 0)
			     (bits b k 0)
			     1)
			  k 0)))
  :rule-classes ()
  :hints (("Goal" :use (:instance bits-sum-plus-1 (x a) (y b) (i k) (j 0)) ;weird hint
           ))))

(local (defthm stick-lemma-3-2
    (implies (and (natp n)
		  (natp k)
		  (natp j)
		  (< k n)
		  (<= j k)
		  (integerp a) ;(bvecp a n)
		  (integerp b) ;(bvecp b n)
                  )
	     (equal (bits (lnot (lxor a b n) n) k j)
		    (lnot (lxor (bits a k j) (bits b k j) (1+ (- k j))) (1+ (- k j)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-lnot bits-logxor natp bvecp-forward)))))

;drop?
(local (defthm stick-lemma-3-3
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
                  )
	     (equal (bitn (lnot (lxor a b n) n) k)
		    (lnot (lxor (bitn a k) (bitn b k) 1) 1)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp)
		  :use ((:instance stick-lemma-3-2 (j k)))))))

(local (defthm stick-lemma-3-4
    (implies (and (natp n)
		  (> n 0)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
                  )
	     (equal (bits (+ a b 1) 0 0)
		    (bits (lnot (lxor a b n) n) 0 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp bvecp-forward)
		  :use ((:instance stick-lemma-3-1 (k 0))
			(:instance stick-lemma-3-2 (k 0) (j 0))
			(:instance bitn-0-1 (x a) (n 0))
			(:instance bitn-0-1 (x b) (n 0)))))))

(local (defthm stick-lemma-3-5
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
		  (iff (equal (bits (+ a b 1) (1- k) 0)
			      0)
		       (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			      0))
		  (not (equal (bits (+ a b 1) (1- k) 0) 0)))
	     (iff (equal (bits (+ a b 1) k 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) k 0)
			 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable lnot-bvecp bits-n-n-rewrite)
		  :use ((:instance bitn-plus-bits
				   (x (lnot (lxor a b n) n))
				   (n k)
				   (m 0))
			(:instance bitn-plus-bits
				   (x (+ a b 1))
				   (n k)
				   (m 0))
			(:instance bits-0-bitn-0
				   (x (lnot (lxor a b n) n))
				   (n k))
			(:instance bits-0-bitn-0
				   (x (+ a b 0))
				   (n k)))))))


(local (defthm stick-lemma-3-7
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (equal (+ (bits a (1- k) 0) (bits b (1- k) 0) 1)
		(expt 2 k)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-mod bvecp-forward)
		  :use (;stick-lemma-3-6
			(:instance stick-lemma-3-1 (k (1- k)))
			(:instance mod-must-be-n
				   (m (+ (bits a (1- k) 0) (bits b (1- k) 0) 1))
				   (n (expt 2 k))))))))

(local (defthm stick-lemma-3-8
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b);(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0)
                  )
	     (equal (bits (+ a b 1) k 0)
		(bits (* (expt 2 k) (+ (bitn a k) (bitn b k) 1)) k 0)))
  :rule-classes ()
  :otf-flg t
  :hints (("Goal" :in-theory (e/d (bits-tail bits-n-n-rewrite ) (BITS-SHIFT-BY-CONSTANT-POWER-OF-2)) ;BOZO remove disable
           :use ((:instance bitn-plus-bits (x (+ 1 A B)) (n k) (m 0))
                 (:instance bitn-0-1 (x a) (n k))
                 (:instance bitn-0-1 (x b) (n k))
                 (:instance bitn-0-1 (x (+ 1 A B)) (n k))
                 (:instance bits-sum-plus-1 (x a) (y b) (i k) (j k))
                 stick-lemma-3-7
                 )))))

(local (defthm stick-lemma-3-9
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b);(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (equal (bits (+ a b 1) k 0)
		(* (expt 2 k)
		   (bits (+ (bitn a k) (bitn b k) 1) 0 0))))
  :rule-classes ()
  :hints (("Goal" :use (stick-lemma-3-8
			(:instance bits-shift-up (x (+ (bitn a k) (bitn b k) 1)) (i 0)))))))

(local (defthm stick-lemma-3-10
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b);(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (iff (equal (bits (+ a b 1) k 0) 0)
		  (equal (bits (+ (bitn a k) (bitn b k) 1) 0 0) 0)))
  :rule-classes ()
  :hints (("Goal" :use (stick-lemma-3-9)))))

(local (defthm stick-lemma-3-11
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (iff (equal (bits (+ a b 1) k 0) 0)
		  (equal (lnot (lxor (bits a k k) (bits b k k) 1) 1) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-n-n-rewrite)
		  :use (stick-lemma-3-10
			(:instance bitn-0-1 (x a) (n k))
			(:instance bitn-0-1 (x b) (n k)))))))

(local (defthm stick-lemma-3-12
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (iff (equal (bits (+ a b 1) k 0) 0)
		  (equal (bits (lnot (lxor a b n) n) k k) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bits-lnot lnot-logxor bitn-lnot ;BOZO these should be enabled?
                                     bits-logxor lnot-bvecp bitn-logxor)
		  :use (stick-lemma-3-11)))))

(local (defthm stick-lemma-3-13
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b);(bvecp b n)
		  (equal (bits (+ a b 1) (1- k) 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			 0))
	     (iff (equal (bits (+ a b 1) k 0) 0)
		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bitn-logxor bitn-lnot bits-n-n-rewrite bits-lnot
                                     bits-logxor lnot-bvecp)
		  :use (stick-lemma-3-12
			(:instance bits-0-bitn-0
				   (x (lnot (lxor a b n) n))
				   (n k)))))))

(local (defthm stick-lemma-3-14
    (implies (and (natp n)
		  (natp k)
		  (< k n)
		  (< 0 k)
		  (integerp a);(bvecp a n)
		  (integerp b) ;(bvecp b n)
		  (iff (equal (bits (+ a b 1) (1- k) 0)
			      0)
		       (equal (bits (lnot (lxor a b n) n) (1- k) 0)
			      0)))
	     (iff (equal (bits (+ a b 1) k 0)
			 0)
		  (equal (bits (lnot (lxor a b n) n) k 0)
			 0)))
  :rule-classes ()
  :hints (("Goal" :use (stick-lemma-3-5
			stick-lemma-3-13)))))

(defthm top-thm-1
  (implies (and (natp n)
                (natp k)
                (< k n)
                (integerp a) ;(bvecp a n)
                (integerp b) ;(bvecp b n)
                )
           (equal (equal (bits (+ a b 1) k 0)
                         0)
                  (equal (bits (lnot (lxor a b n) n) k 0)
                         0)))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable bitn-logxor)
           :induct (natp-induct k))
	  ("Subgoal *1/2" :use stick-lemma-3-14)
	  ("Subgoal *1/1" :use stick-lemma-3-4)))

