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

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

(in-package "C")

(include-book "defstruct")

(local (include-book "std/alists/top" :dir :system))
(local (include-book "std/typed-lists/atom-listp" :dir :system))
(local (include-book "std/typed-lists/symbol-listp" :dir :system))

(local (include-book "kestrel/built-ins/disable" :dir :system))
(local (acl2::disable-most-builtin-logic-defuns))
(local (acl2::disable-builtin-rewrite-rules-for-defaults))

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

(defxdoc+ atc-tag-tables
  :parents (atc-event-and-code-generation)
  :short "Tables of @(tsee defstruct)s, and operations on these tables."
  :long
  (xdoc::topstring
   (xdoc::p
    "The @('tag') refers to the fact that C structure types,
     represented by @(tsee defstruct) in the shallow embedding,
     are identified by tags."))
  :order-subtopics t
  :default-parent t)

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

(fty::defprod atc-tag-info
  :short "Fixtype of information associated to
          an ACL2 @(tsee defstruct) symbol translated to a C structure type."
  :long
  (xdoc::topstring
   (xdoc::p
    "This consists of the information in the @(tsee defstruct) table
     plus some additional information that is more specific to ATC
     than to @(tsee defstruct), which is part of the shallow embedding.
     This additional information consists of:")
   (xdoc::ul
    (xdoc::li
     "The names of the theorems generated by ATC
      for rewriting calls of @(tsee exec-member) and @(tsee exec-memberp)
      to calls of @(tsee defstruct) readers;
      see @(tsee atc-gen-tag-member-read-all-thms).")
    (xdoc::li
     "The names of the theorems generated by ATC
      for rewriting calls of @(tsee exec-expr)
      on assignments with a @(':member') or @(':memberp') left expression
      to calls of @(tsee defstruct) writers;
      see @(tsee atc-gen-tag-member-write-all-thms)."))
   (xdoc::p
    "The latter theorems depend on
     @(tsee exec-member), @(tsee exec-memberp), and @(tsee exec-expr),
     so they are not generated by @(tsee defstruct)
     to avoid having @(tsee defstruct) depend on
     those functions from the dynamic semantics."))
  ((defstruct defstruct-info)
   (member-read-thms symbol-list)
   (member-write-thms symbol-listp))
  :pred atc-tag-infop)

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

(defirrelevant irr-atc-tag-info
  :short "Irrelevant information about a tag."
  :type atc-tag-infop
  :body (make-atc-tag-info :defstruct (irr-defstruct-info)
                           :member-read-thms nil
                           :member-write-thms nil))

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

(fty::defalist atc-string-taginfo-alist
  :short "Fixtype of alists from strings to tag information."
  :key-type string
  :val-type atc-tag-info
  :true-listp t
  :keyp-of-nil nil
  :valp-of-nil nil
  :pred atc-string-taginfo-alistp
  ///

  (defrule atc-tag-infop-of-cdr-assoc-equal-when-atc-string-taginfo-alistp
    (implies (and (atc-string-taginfo-alistp prec-tags)
                  (assoc-equal tag prec-tags))
             (atc-tag-infop (cdr (assoc-equal tag prec-tags))))
    :enable assoc-equal))

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

(define atc-get-tag-info ((tag identp) (prec-tags atc-string-taginfo-alistp))
  :returns (info atc-tag-infop)
  :short "Retrieve the information about a tag from a tag table."
  :long
  (xdoc::topstring
   (xdoc::p
    "This is always called on tag that are in the table,
     so we thrown an internal error if the tag is not in the table."))
  (b* ((info (cdr (assoc-equal (ident->name tag) prec-tags)))
       ((unless (atc-tag-infop info))
        (raise "Internal error: no information for tag ~x0." tag)
        (irr-atc-tag-info)))
    info))

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

(define atc-string-taginfo-alist-to-recognizers
  ((prec-tags atc-string-taginfo-alistp))
  :returns (recognizers symbol-listp)
  :short "Project the recognizers out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (recog (defstruct-info->recognizer (atc-tag-info->defstruct info)))
       (recogs (atc-string-taginfo-alist-to-recognizers (cdr prec-tags))))
    (cons recog recogs)))

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

(define atc-string-taginfo-alist-to-readers
  ((prec-tags atc-string-taginfo-alistp))
  :returns (readers symbol-listp)
  :short "Project the readers out of a tag information alist."
  :long
  (xdoc::topstring
   (xdoc::p
    "These are only the readers that represent C code.
     For an integer member,
     it is the reader in the @('reader') component.
     For an array member,
     it is the reader in the @('reader-element') component."))
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (readers (atc-string-taginfo-alist-to-readers-aux
                 (defstruct-info->members (atc-tag-info->defstruct info))))
       (more-readers (atc-string-taginfo-alist-to-readers (cdr prec-tags))))
    (append readers more-readers))
  :prepwork
  ((define atc-string-taginfo-alist-to-readers-aux
     ((members defstruct-member-info-listp))
     :returns (readers symbol-listp)
     :parents nil
     (b* (((when (endp members)) nil)
          (member (car members))
          (reader (if (type-integerp
                       (member-type->type
                        (defstruct-member-info->memtype member)))
                      (defstruct-member-info->reader member)
                    (defstruct-member-info->reader-element member)))
          (more-readers (atc-string-taginfo-alist-to-readers-aux
                         (cdr members))))
       (cons reader more-readers)))))

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

(define atc-string-taginfo-alist-to-writers
  ((prec-tags atc-string-taginfo-alistp))
  :returns (writers symbol-listp)
  :short "Project the writers out of a tag information alist."
  :long
  (xdoc::topstring
   (xdoc::p
    "These are only the writers that represent C code.
     For an integer member,
     it is the writer in the @('writer') component.
     For an array member,
     it is the writer in the @('writer-element') component."))
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (writers (atc-string-taginfo-alist-to-writers-aux
                 (defstruct-info->members (atc-tag-info->defstruct info))))
       (more-writers (atc-string-taginfo-alist-to-writers (cdr prec-tags))))
    (append writers more-writers))
  :prepwork
  ((define atc-string-taginfo-alist-to-writers-aux
     ((members defstruct-member-info-listp))
     :returns (writers symbol-listp)
     :parents nil
     (b* (((when (endp members)) nil)
          (member (car members))
          (writer (if (type-integerp
                       (member-type->type
                        (defstruct-member-info->memtype member)))
                      (defstruct-member-info->writer member)
                    (defstruct-member-info->writer-element member)))
          (more-writers (atc-string-taginfo-alist-to-writers-aux
                         (cdr members))))
       (cons writer more-writers)))))

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

(define atc-string-taginfo-alist-to-reader-return-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the return type theorems
          for structure readers
          out of a tag information alist."
  :long
  (xdoc::topstring
   (xdoc::p
    "These are only the readers that represent C code.
     For an integer member,
     it is the theorem in the @('reader-return-thm') component.
     For an array member,
     it is the theorem in the @('reader-element-return-thm') component."))
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thms (atc-string-taginfo-alist-to-reader-return-thms-aux
              (defstruct-info->members (atc-tag-info->defstruct info))))
       (more-thms
        (atc-string-taginfo-alist-to-reader-return-thms (cdr prec-tags))))
    (append thms more-thms))
  :prepwork
  ((define atc-string-taginfo-alist-to-reader-return-thms-aux
     ((members defstruct-member-info-listp))
     :returns (reader-return-thms symbol-listp)
     :parents nil
     (b* (((when (endp members)) nil)
          (member (car members))
          (thm (if (type-integerp
                    (member-type->type
                     (defstruct-member-info->memtype member)))
                   (defstruct-member-info->reader-return-thm member)
                 (defstruct-member-info->reader-element-return-thm member)))
          (more-thms
           (atc-string-taginfo-alist-to-reader-return-thms-aux (cdr members))))
       (cons thm more-thms)))))

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

(define atc-string-taginfo-alist-to-writer-return-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the return type theorems
          for structure writers
          out of a tag information alist."
  :long
  (xdoc::topstring
   (xdoc::p
    "These are only the writers that represent C code.
     For an integer member,
     it is the theorem in the @('writer-return-thm') component.
     For an array member,
     it is the theorem in the @('writer-element-return-thm') component."))
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thms (atc-string-taginfo-alist-to-writer-return-thms-aux
              (defstruct-info->members (atc-tag-info->defstruct info))))
       (more-thms
        (atc-string-taginfo-alist-to-writer-return-thms (cdr prec-tags))))
    (append thms more-thms))
  :prepwork
  ((define atc-string-taginfo-alist-to-writer-return-thms-aux
     ((members defstruct-member-info-listp))
     :returns (writer-return-thms symbol-listp)
     :parents nil
     (b* (((when (endp members)) nil)
          (member (car members))
          (thm (if (type-integerp
                    (member-type->type
                     (defstruct-member-info->memtype member)))
                   (defstruct-member-info->writer-return-thm member)
                 (defstruct-member-info->writer-element-return-thm member)))
          (more-thms
           (atc-string-taginfo-alist-to-writer-return-thms-aux (cdr members))))
       (cons thm more-thms)))))

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

(define atc-string-taginfo-alist-to-not-error-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the non-error theorems out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->not-error-thm (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-not-error-thms (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-valuep-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @(tsee valuep) theorems out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->valuep-thm (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-valuep-thms (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-value-kind-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @(tsee value-kind) theorems
          out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->value-kind-thm (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-value-kind-thms (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-type-of-value-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @(tsee type-of-value) theorems
          out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->type-of-value-thm (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-type-of-value-thms (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-flexiblep-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @('flexiblep') flag theorems
          out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->flexiblep-thm (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-flexiblep-thms (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-member-read-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @(tsee exec-member) and @(tsee exec-memberp) theorems
          out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thms (atc-tag-info->member-read-thms info))
       (more-thms
        (atc-string-taginfo-alist-to-member-read-thms (cdr prec-tags))))
    (append thms more-thms)))

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

(define atc-string-taginfo-alist-to-member-write-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the @(tsee exec-expr)
          with @(':member') and @(':memberp') theorems
          out of a tag information alist."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thms (atc-tag-info->member-write-thms info))
       (more-thms
        (atc-string-taginfo-alist-to-member-write-thms (cdr prec-tags))))
    (append thms more-thms)))

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

(define atc-string-taginfo-alist-to-type-to-quoted-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the theorems to rewrite
           the structure types to their quoted versions."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->type-to-quoted-thm
              (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-type-to-quoted-thms
              (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-string-taginfo-alist-to-pointer-type-to-quoted-thms
  ((prec-tags atc-string-taginfo-alistp))
  :returns (thms symbol-listp)
  :short "Project the theorems to rewrite
           the pointer types to the structure types to their quoted versions."
  (b* (((when (endp prec-tags)) nil)
       (info (cdar prec-tags))
       (thm (defstruct-info->pointer-type-to-quoted-thm
              (atc-tag-info->defstruct info)))
       (thms (atc-string-taginfo-alist-to-pointer-type-to-quoted-thms
              (cdr prec-tags))))
    (cons thm thms)))

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

(define atc-type-to-recognizer ((type typep)
                                (prec-tags atc-string-taginfo-alistp))
  :returns (recognizer symbolp)
  :short "ACL2 recognizer corresponding to a C type."
  :long
  (xdoc::topstring
   (xdoc::p
    "For a supported integer type,
     the predicate is the recognizer of values of that type.
     For a structure type,
     the predicate is the recognizer of structures of that type.
     For a pointer to integer type,
     the predicate is the recognizer of the referenced integer type.
     For a pointer to structure type,
     the predicate is the recognizer of structures of that type.
     For an array of integer type,
     the predicate is the recognizer of arrays of that element type.")
   (xdoc::p
    "This is based on our current ACL2 representation of C types,
     which may be extended in the future.
     Note that, in the current representation,
     the predicate corresponding to each type
     is never a recognizer of pointer values."))
  (type-case
   type
   :void (raise "Internal error: type ~x0." type)
   :char (raise "Internal error: type ~x0." type)
   :schar 'scharp
   :uchar 'ucharp
   :sshort 'sshortp
   :ushort 'ushortp
   :sint 'sintp
   :uint 'uintp
   :slong 'slongp
   :ulong 'ulongp
   :sllong 'sllongp
   :ullong 'ullongp
   :struct (defstruct-info->recognizer
             (atc-tag-info->defstruct
              (atc-get-tag-info type.tag prec-tags)))
   :pointer (type-case
             type.to
             :void (raise "Internal error: type ~x0." type)
             :char (raise "Internal error: type ~x0." type)
             :schar 'scharp
             :uchar 'ucharp
             :sshort 'sshortp
             :ushort 'ushortp
             :sint 'sintp
             :uint 'uintp
             :slong 'slongp
             :ulong 'ulongp
             :sllong 'sllongp
             :ullong 'ullongp
             :struct (defstruct-info->recognizer
                       (atc-tag-info->defstruct
                        (atc-get-tag-info type.to.tag prec-tags)))
             :pointer (raise "Internal error: type ~x0." type)
             :array (raise "Internal error: type ~x0." type))
   :array (type-case
           type.of
           :void (raise "Internal error: type ~x0." type)
           :char (raise "Internal error: type ~x0." type)
           :schar 'schar-arrayp
           :uchar 'uchar-arrayp
           :sshort 'sshort-arrayp
           :ushort 'ushort-arrayp
           :sint 'sint-arrayp
           :uint 'uint-arrayp
           :slong 'slong-arrayp
           :ulong 'ulong-arrayp
           :sllong 'sllong-arrayp
           :ullong 'ullong-arrayp
           :struct (raise "Internal error: type ~x0." type)
           :pointer (raise "Internal error: type ~x0." type)
           :array (raise "Internal error: type ~x0." type))))

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

(define atc-type-to-valuep-thm ((type typep)
                                (prec-tags atc-string-taginfo-alistp))
  :returns (valuep-thm symbolp)
  :short "Name of the theorems saying that @(tsee valuep) holds
          when the recognizer for a type holds."
  (if (or (type-case type :struct)
          (and (type-case type :pointer)
               (type-case (type-pointer->to type) :struct)))
      (defstruct-info->valuep-thm
        (atc-tag-info->defstruct
         (atc-get-tag-info (if (type-case type :struct)
                               (type-struct->tag type)
                             (type-struct->tag (type-pointer->to type)))
                           prec-tags)))
    (pack 'valuep-when- (atc-type-to-recognizer type prec-tags))))

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

(define atc-type-to-value-kind-thm ((type typep)
                                    (prec-tags atc-string-taginfo-alistp))
  :returns (value-kind-thm symbolp)
  :short "Name of the theorems asserting what @(tsee value-kind) is
          when the recognizer for a type holds."
  (if (or (type-case type :struct)
          (and (type-case type :pointer)
               (type-case (type-pointer->to type) :struct)))
      (defstruct-info->value-kind-thm
        (atc-tag-info->defstruct
         (atc-get-tag-info (if (type-case type :struct)
                               (type-struct->tag type)
                             (type-struct->tag (type-pointer->to type)))
                           prec-tags)))
    (pack 'value-kind-when- (atc-type-to-recognizer type prec-tags))))

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

(define atc-type-to-type-of-value-thm ((type typep)
                                       (prec-tags atc-string-taginfo-alistp))
  :returns (type-of-value-thm symbolp)
  :short "Name of the theorems asserting what @(tsee type-of-value) is
          when the recognizer for a type holds."
  (if (or (type-case type :struct)
          (and (type-case type :pointer)
               (type-case (type-pointer->to type) :struct)))
      (defstruct-info->type-of-value-thm
        (atc-tag-info->defstruct
         (atc-get-tag-info (if (type-case type :struct)
                               (type-struct->tag type)
                             (type-struct->tag (type-pointer->to type)))
                           prec-tags)))
    (pack 'type-of-value-when- (atc-type-to-recognizer type prec-tags))))

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

(define atc-type-to-notflexarrmem-thms ((type typep)
                                        (prec-tags atc-string-taginfo-alistp))
  :returns (notflexarrmem-thms symbol-listp)
  :short "Names of the theorems asserting that
          @(tsee flexible-array-member-p) does not hold
          on a value of a given type."
  :long
  (xdoc::topstring
   (xdoc::p
    "For an integer type,
     this is just one theorem related to that type's recognizer.
     For a pointer or an array, it is just one theorem for pointers.
     For a struct, it consists of the general theorem for structs,
     which has a hypothesis saying that the struct
     does not have a flexible array member,
     plus the theorem asserting that the struct in question
     does not have a flexible array member,
     needed to relieve the hypothesis;
     this is always used on structs without flexible array members."))
  (cond ((type-integerp type)
         (list (pack 'not-flexible-array-member-p-when-
                     (atc-type-to-recognizer type prec-tags))))
        ((or (type-case type :pointer)
             (type-case type :array))
         (list 'not-flexible-array-member-p-when-value-pointer))
        ((type-case type :struct)
         (list 'not-flexible-array-member-p-when-value-struct
               (defstruct-info->flexiblep-thm
                 (atc-tag-info->defstruct
                  (atc-get-tag-info (type-struct->tag type) prec-tags)))))
        (t (raise "Internal error: unexpected type ~x0." type))))

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

(define atc-type-to-type-to-quoted-thms
  ((type typep)
   (prec-tags atc-string-taginfo-alistp))
  :returns (type-to-quoted-thms symbol-listp)
  :short "Names of the theorems for rewriting
          the struct type
          to quoted form."
  :long
  (xdoc::topstring
   (xdoc::p
    "If the type is a structure type,
     we return the singleton list of
     the theorem that rewrites the type to quoted form.
     Otherwise, we return the empty list."))
  (if (type-case type :struct)
      (list (defstruct-info->type-to-quoted-thm
              (atc-tag-info->defstruct
               (atc-get-tag-info (type-struct->tag type)
                                 prec-tags))))
    nil))

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

(define atc-type-to-pointer-type-to-quoted-thms
  ((type typep)
   (prec-tags atc-string-taginfo-alistp))
  :returns (pointer-type-to-quoted-thms symbol-listp)
  :short "Names of the theorems for rewriting
          the pointer type to the struct type
          to quoted form."
  :long
  (xdoc::topstring
   (xdoc::p
    "If the type is a pointer to structure type,
     we return the singleton list of
     the theorem that rewrites the type to quoted form.
     Otherwise, we return the empty list."))
  (if (and (type-case type :pointer)
           (type-case (type-pointer->to type) :struct))
      (list (defstruct-info->pointer-type-to-quoted-thm
              (atc-tag-info->defstruct
               (atc-get-tag-info (type-struct->tag (type-pointer->to type))
                                 prec-tags))))
    nil))
