; FTY Library
;
; Copyright (C) 2025 Kestrel Institute (http://www.kestrel.edu)
;
; License: A 3-clause BSD license. See the LICENSE file distributed with ACL2.
;
; Author: Alessandro Coglio (www.alessandrocoglio.info)

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

(in-package "FTY")

(include-book "defbyte")

(include-book "ihs/basic-definitions" :dir :system)

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

(defxdoc defbyte-ihs-theorems

  :parents (defbyte)

  :short (xdoc::topstring-p
          "Introduce some theorems about a @(tsee defbyte) instance
           and functions in the "
          (xdoc::seetopic "acl2::ihs" "IHS") " library.")

  :long

  (xdoc::topstring

   (xdoc::h3 "Introduction")

   (xdoc::p
    "Since @(tsee unsigned-byte-p) and @(tsee signed-byte-p)
     have certain formal relations with functions in the IHS library,
     similar relations can be proved for instances of @(tsee defbyte).")

   (xdoc::p
    "This macro automates this process,
     by including the IHS basic definitions
     and by generating theorems.")

   (xdoc::p
    "The reason for not having @(tsee defbyte) itself generate these theorems
     is to avoid always including IHS when using @(tsee defbyte).
     Having a separate macro promotes greater modularity.")

   (xdoc::h3 "General Form")

   (xdoc::codeblock
    "(defbyte-ihs-theorems type)")

   (xdoc::h3 "Inputs")

   (xdoc::desc
    "@('type')"
    (xdoc::p
     "A symbol that names a fixtype previously introduced via @(tsee defbyte).
      This specifies the @(tsee defbyte) instance
      for which the theorems are generated."))

   (xdoc::h3 "Generated Events")

   (xdoc::desc
    "@('bytep-of-loghead/logext-of-size')"
    (xdoc::p
     "One of the following:")
    (xdoc::ul
     (xdoc::li
      "If the @(tsee defbyte) instance is unsigned,
       a rewrite rule saying that
       @('(loghead size ...)'), where @('size') is the byte size,
       satisfies the recognizer of the bytes.")
     (xdoc::li
      "If the @(tsee defbyte) instance is signed,
       a rewrite rule saying that
       @('(logext size ...)'), where @('size') is the byte size,
       satisfies the recognizer of the bytes.")))

   (xdoc::desc
    "@('loghead/logext-of-size-when-bytep')"
    (xdoc::p
     "One of the following:")
    (xdoc::ul
     (xdoc::li
      "If the @(tsee defbyte) instance is unsigned,
       a rewrite rule saying that
       @('(loghead size x)'), where @('size') is the byte size,
       simplifies to @('x'),
       when @('x') satisfies the recognizer of the bytes.")
     (xdoc::li
      "If the @(tsee defbyte) instance is signed,
       a rewrite rule saying that
       @('(logext size x)'), where @('size') is the byte size,
       simplifies to @('x'),
       when @('x') satisfies the recognizer of the bytes.")))

   (xdoc::desc
    "@('logtail-of-size-when-bytep')"
    (xdoc::p
     "One of the following:")
    (xdoc::ul
     (xdoc::li
      "If the @(tsee defbyte) instance is unsigned,
       a rewrite rule saying that
       @('(logtail size x)'), where @('size') is the byte size,
       simplifies to @('0'),
       when @('x') satisfies the recognizer of the bytes.")
     (xdoc::li
      "If the @(tsee defbyte) instance is signed,
       a rewrite rule saying that
       @('(logtail size x)'), where @('size') is the byte size,
       simplifies to @('-1') if @('x') is negative and to @('0') otherwise,
       when @('x') satisfies the recognizer of the bytes.")))))

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

(acl2::defxdoc+ defbyte-ihs-theorems-implementation
  :parents (defbyte-ihs-theorems)
  :short "Implementation of @(tsee defbyte-ihs-theorems)."
  :order-subtopics t
  :default-parent t)

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

(define defbyte-ihs-theorems-fn (type (wrld plist-worldp))
  :returns (event "A @(tsee acl2::pseudo-event-formp).")
  :mode :program
  :short "Event generated by @(tsee defbyte-ihs-theorems)."
  (b* (;; validate the TYPE input:
       ((unless (symbolp type))
        (raise "The TYPE input must be a symbol, ~
                but it is ~x0 instead." type))
       (defbyte-table (table-alist *defbyte-table-name* wrld))
       (defbyte-pair (assoc-eq type defbyte-table))
       ((unless defbyte-pair)
        (raise "The TYPE input ~x0 must name a type ~
                previously introduced via DEFBYTE, ~
                but this is not the case." type))
       ;; retrieve size and signedness from the DEFBYTE table:
       (defbyte-info (cdr defbyte-pair))
       (size (defbyte-info->size defbyte-info))
       (signed (defbyte-info->signed defbyte-info))
       ;; retrieve type recognizer from the fixtype table:
       (fty-table (get-fixtypes-alist wrld))
       (fty-info (find-fixtype type fty-table))
       (bytep (fixtype->pred fty-info))
       ;; choice between LOGHEAD and LOGEXT:
       (loghead/logext (if signed 'acl2::logext 'acl2::loghead))
       ;; name of the generated XDOC topic:
       (type-ihs-theorems
        (acl2::packn-pos (list type '-ihs-theorems) bytep))
       ;; short string for XDOC topic:
       (short (str::cat "Theorems about @(tsee acl2::"
                        (str::downcase-string (symbol-name type))
                        ") and IHS functions."))
       ;; name of the generated theorems:
       (bytep-of-loghead/logext-of-size
        (acl2::packn-pos (list bytep '-of- loghead/logext '-of- size) bytep))
       (loghead/logext-of-size-when-bytep
        (acl2::packn-pos (list loghead/logext '-of- size '-when- bytep) bytep))
       (logtail-of-size-when-bytep
        (acl2::packn-pos (list 'logtail-of- size '-when- bytep) bytep))
       ;; variable in the generated theorems:
       (x (intern-in-package-of-symbol "X" bytep))
       ;; generated theorems:
       (event
        `(defsection ,type-ihs-theorems
           :parents (,type fty::defbyte-standard-instances-ihs-theorems)
           :short ,short
           (local (include-book "arithmetic-5/top" :dir :system))
           (defrule ,bytep-of-loghead/logext-of-size
             (,bytep (,loghead/logext ,size ,x))
             :enable ,bytep)
           (defrule ,loghead/logext-of-size-when-bytep
             (implies (,bytep ,x)
                      (equal (,loghead/logext ,size ,x) ,x))
             :enable ,bytep)
           (defrule ,logtail-of-size-when-bytep
             (implies (,bytep ,x)
                      (equal (acl2::logtail ,size ,x)
                             ,(if signed
                                  `(if (< ,x 0) -1 0)
                                0)))
             :enable ,bytep))))
    event))

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

(defsection defbyte-ihs-theorems-macro-definition
  :short "Definition of the @(tsee defbyte-ihs-theorems) macro."
  :long "@(def defbyte-ihs-theorems)"
  (defmacro defbyte-ihs-theorems (type)
    `(make-event (defbyte-ihs-theorems-fn ',type (w state)))))
