; Rules to introduce BV ops
;
; Copyright (C) 2022-2026 Kestrel Institute
;
; License: A 3-clause BSD license. See the file books/3BSD-mod.txt.
;
; Author: Eric Smith (eric.smith@kestrel.edu)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "ACL2")

(include-book "bvand-def")
(include-book "bvor-def")
(include-book "bvxor-def")
(include-book "bvplus-def")
(include-book "bvminus")
(include-book "bv-syntax")
(include-book "bvcat-def")
(include-book "bvsx-def")
(include-book "bvif")
(include-book "defs-bitwise")
(include-book "unsigned-byte-p-forced")
(include-book "ihs/basic-definitions" :dir :system) ;for logmask
(local (include-book "kestrel/arithmetic-light/floor" :dir :system))
(local (include-book "kestrel/arithmetic-light/times" :dir :system))
(local (include-book "kestrel/arithmetic-light/expt" :dir :system))
(local (include-book "bvand"))
(local (include-book "bvor"))
(local (include-book "logxor-b"))
(local (include-book "logior-b"))
(local (include-book "logand-b"))
(local (include-book "slice-rules"))
(local (include-book "slice"))
(local (include-book "rules"))

;; There are several ways to convert logops (like logxor) to bv ops (like bvxor):
;; 1. If there is a surrounding operator that chops its argument (see convert-to-bv-rules.lisp).
;; 2. If we can tell syntactically what the BV size of an operand is.
;; 3. If we have an unsigned-byte-p hyp about an operand.
;; 4. If we just guess that the operand(s) have size 32 or 64 or whatever and can prove that.
;; Functions with multiple operands may require both to have the given size.

;; See also ../axe/bv-intro-rules.lisp

;; We'll keep these disabled as they may conflict with opening up the BV
;; functions.

;; todo: more theory invars?
;; todo: rules for bvchop, slice, and getbit or each thing?

(defthmd bvchop-of-lognot-becomes-bvnot
  (equal (bvchop size (lognot x))
         (bvnot size x))
  :hints (("Goal" :in-theory (enable bvnot))))

(theory-invariant (incompatible (:rewrite bvchop-of-lognot-becomes-bvnot) (:definition bvnot)))

;; or go to getbit of bvnot first?
(defthmd getbit-of-lognot
  (implies (natp m)
           (equal (getbit m (lognot x))
                  (bvnot 1 (getbit m x))))
  :hints (("Goal" :in-theory (e/d (lognot
                                   getbit
                                   SLICE-OF-SUM-CASES
                                   ifix)
                                  (;BITXOR-OF-SLICE-ARG2
                                   )))))

(defthmd slice-of-lognot
  (implies (and (natp high) ;drop?
                (natp low))
           (equal (slice high low (lognot x))
                  (slice high low (bvnot (+ 1 high) x))))
  :hints (("Goal" ;:cases ((natp high))
           :in-theory (enable bvnot))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Is this really an intro rule?
(defthm getbit-of-logmask
  (implies (and (natp n)
                (integerp width))
           (equal (getbit n (logmask width))
                  (if (< n width)
                      1
                    0))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthmd bvchop-of-logand-becomes-bvand
  (equal (bvchop size (logand x y))
         (bvand size x y))
  :hints (("Goal" :in-theory (enable bvand))))

(defthmd bvchop-of-logior-becomes-bvor
  (equal (bvchop size (logior x y))
         (bvor size x y))
  :hints (("Goal" :in-theory (enable bvor))))

(defthmd bvchop-of-logxor-becomes-bvxor
  (equal (bvchop size (logxor x y))
         (bvxor size x y))
  :hints (("Goal" :in-theory (enable bvxor))))

(defthmd bvchop-of---becomes-bvminus
  (implies (and (integerp x)
                (integerp y))
           (equal (bvchop size (- x y))
                  (bvminus size x y)))
  :hints (("Goal" :in-theory (enable bvminus))))

;; We only need to get the size of one argument for logand
(defthmd logand-becomes-bvand
  (implies (and (bind-free (bind-var-to-bv-term-size 'size x))
                (unsigned-byte-p-forced size x)
                (integerp y))
           (equal (logand x y)
                  (bvand size x y)))
  :hints (("Goal" :in-theory (enable bvand logand-of-bvchop))))

(defthmd logand-becomes-bvand-alt
  (implies (and (bind-free (bind-var-to-bv-term-size 'size y))
                (unsigned-byte-p-forced size y)
                (integerp x))
           (equal (logand x y)
                  (bvand size x y)))
  :hints (("Goal" :use (:instance logand-becomes-bvand (x y) (y x)))))

;; ;; subsumed?
;; (defthmd logand-of-bvchop-becomes-bvand
;;   (equal (logand y (bvchop width x))
;;          (bvand width y x))
;;   :hints (("Goal" :use (:instance logand-becomes-bvand (size width) (x (bvchop width x)))
;;            )))

;; ;; subsumed?
;; (defthmd logand-of-bvchop-becomes-bvand-alt
;;   (equal (logand (bvchop width x) y)
;;          (bvand width y x))
;;   :hints (("Goal" :use (:instance logand-becomes-bvand (size width) (x (bvchop width x)))
;;            )))

;; We only need to get the size of one argument for logand
(defthmd logand-becomes-bvand-when-unsigned-byte-p-arg1
  (implies (and (unsigned-byte-p size x) ;size is a free var
                ;(unsigned-byte-p size y)
                (integerp y))
           (equal (logand x y)
                  (bvand size x y)))
  :hints (("Goal" :use logand-becomes-bvand
                  :in-theory (enable unsigned-byte-p-forced))))

;; We only need to get the size of one argument for logand
(defthmd logand-becomes-bvand-when-unsigned-byte-p-arg2
  (implies (and (unsigned-byte-p size y) ;size is a free var
                ;(unsigned-byte-p size x)
                )
           (equal (logand x y)
                  (bvand size x y)))
  :hints (("Goal" :use logand-becomes-bvand-alt
                  :in-theory (enable unsigned-byte-p-forced))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthmd logior-becomes-bvor
  (implies (and (bind-free (bind-var-to-bv-term-size 'size x))
                (unsigned-byte-p-forced size y)
                (unsigned-byte-p-forced size x) ; should never fail
                )
           (equal (logior x y)
                  (bvor size x y)))
  :hints (("Goal" :in-theory (enable bvor))))

(defthmd logior-becomes-bvor-alt
  (implies (and (bind-free (bind-var-to-bv-term-size 'size y))
                (unsigned-byte-p-forced size x)
                (unsigned-byte-p-forced size y) ; should never fail
                )
           (equal (logior x y)
                  (bvor size x y)))
  :hints (("Goal" :use (:instance logior-becomes-bvor (x y) (y x))
           :in-theory (disable logior-becomes-bvor))))

(defthmd logior-becomes-bvor-when-unsigned-byte-p-arg1
  (implies (and (unsigned-byte-p size x) ;size is a free var
                (unsigned-byte-p size y))
           (equal (logior x y)
                  (bvor size x y)))
  :hints (("Goal" :use logior-becomes-bvor
                  :in-theory (e/d (unsigned-byte-p-forced)
                                  (logior-becomes-bvor)))))

(defthmd logior-becomes-bvor-when-unsigned-byte-p-arg2
  (implies (and (unsigned-byte-p size y) ;size is a free var
                (unsigned-byte-p size x))
           (equal (logior x y)
                  (bvor size x y)))
  :hints (("Goal" :use logior-becomes-bvor-alt
                  :in-theory (e/d (unsigned-byte-p-forced)
                                  (logior-becomes-bvor-alt)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthmd logxor-becomes-bvxor
  (implies (and (bind-free (bind-var-to-bv-term-size 'size x))
                (unsigned-byte-p-forced size y)
                (unsigned-byte-p-forced size x) ; should never fail
                )
           (equal (logxor x y)
                  (bvxor size x y)))
  :hints (("Goal" :in-theory (enable bvxor))))

(defthmd logxor-becomes-bvxor-alt
  (implies (and (bind-free (bind-var-to-bv-term-size 'size y))
                (unsigned-byte-p-forced size x)
                (unsigned-byte-p-forced size y) ; should never fail
                )
           (equal (logxor x y)
                  (bvxor size x y)))
  :hints (("Goal" :use (:instance logxor-becomes-bvxor (x y) (y x))
           :in-theory (disable logxor-becomes-bvxor))))

(defthmd logxor-becomes-bvxor-when-unsigned-byte-p-arg1
  (implies (and (unsigned-byte-p size x) ;size is a free var
                (unsigned-byte-p size y)
                )
           (equal (logxor x y)
                  (bvxor size x y)))
  :hints (("Goal" :use logxor-becomes-bvxor
                  :in-theory (e/d (unsigned-byte-p-forced)
                                  (logxor-becomes-bvxor)))))

(defthmd logxor-becomes-bvxor-when-unsigned-byte-p-arg2
  (implies (and (unsigned-byte-p size y) ;size is a free var
                (unsigned-byte-p size x)
                )
           (equal (logxor x y)
                  (bvxor size x y)))
  :hints (("Goal" :use logxor-becomes-bvxor-alt
                  :in-theory (e/d (unsigned-byte-p-forced)
                                  (logxor-becomes-bvxor-alt)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthmd logapp-becomes-bvcat-when-unsigned-byte-p-1
  (implies (unsigned-byte-p 1 j)
           (equal (logapp size i j)
                  (bvcat 1 j size i)))
  :hints (("Goal" :in-theory (enable bvcat))))

;; logapp does not indicate the size of the high bits, so we have to try to
;; figure it out.
(defthmd logapp-becomes-bvcat-when-bv
  (implies (and (bind-free (bind-var-to-bv-term-size 'jsize j) (jsize))
                (unsigned-byte-p-forced jsize j))
           (equal (logapp size i j)
                  (bvcat jsize j size i)))
  :hints (("Goal" :in-theory (enable bvcat))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthm ash-of-bvchop-becomes-bvcat
  (implies (and (natp amt)
                (natp xsize))
           (equal (ash (bvchop xsize x) amt)
                  (bvcat (+ xsize amt)
                         (bvchop xsize x)
                         amt
                         0)))
  :hints (("Goal" :in-theory (enable bvcat ash))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defthmd bvif-of---arg3
  (implies (integerp x)
           (equal (bvif size test (- x) z)
                  (bvif size test (bvuminus size x) z)))
  :hints (("Goal" :in-theory (enable bvif bvuminus bvminus))))

(defthmd bvif-of---arg4
  (implies (integerp x)
           (equal (bvif size test z (- x))
                  (bvif size test z (bvuminus size x))))
  :hints (("Goal" :in-theory (enable bvif bvuminus bvminus))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; replace with a general rule?
(defthmd bvplus-of-logext-arg2-convert-to-bv
  (implies (and (< size2 size) ; could allow =
                (integerp size)
                (posp size2))
           (equal (bvplus size (logext size2 x) y)
                  (bvplus size (bvsx size size2 x) y)))
  :hints (("Goal" :cases ((equal size size2)))))

;; replace with a general rule?
(defthmd bvplus-of-logext-arg3-convert-to-bv
  (implies (and (< size2 size) ; could allow =
                (integerp size)
                (posp size2))
           (equal (bvplus size x (logext size2 y))
                  (bvplus size x (bvsx size size2 y))))
  :hints (("Goal" :cases ((equal size size2)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; replace with a general rule?
(defthmd bvminus-of-logext-arg2-convert-to-bv
  (implies (and (< size2 size) ; could allow =
                (integerp size)
                (posp size2))
           (equal (bvminus size (logext size2 x) y)
                  (bvminus size (bvsx size size2 x) y)))
  :hints (("Goal" :cases ((equal size size2)))))

;; replace with a general rule?
(defthmd bvminus-of-logext-arg3-convert-to-bv
  (implies (and (< size2 size) ; could allow =
                (integerp size)
                (posp size2))
           (equal (bvminus size x (logext size2 y))
                  (bvminus size x (bvsx size size2 y))))
  :hints (("Goal" :cases ((equal size size2)))))
