; C 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 "C2C")

(include-book "variables-in-computation-states")

(include-book "std/util/defund-sk" :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))
(set-induction-depth-limit 0)

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

(defxdoc+ proof-generation-theorems
  :parents (transformation-tools)
  :short "Theorems supporting proof generation."
  :long
  (xdoc::topstring
   (xdoc::p
    "The proof hints generated by transformations
     reference the general theorems that we collect here."))
  :order-subtopics t
  :default-parent t)

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

(defsection exec-congruence-theorems
  :short "Congruence theorems about execution."
  :long
  (xdoc::topstring
   (xdoc::p
    "These are not congruence rules in the ACL2 technical sense,
     but they are theorems expressing congruence-like properties:
     given two constructs (before and after a transformation, i.e. old and new),
     if the executions of their sub-constucts are equivalent,
     then the executions of the super-constructa are equivalent.
     Here `equivalent' means the following:
     if the execution of the old construct does not yield an error,
     neither does the execution of the new construct,
     and the two return the same results.")
   (xdoc::p
    "The theorems for identifier expressions (i.e. variables) and constants
     are a bit different from the others,
     because those expressions have no sub-expressions.
     However, the form is fairly similar, given that difference.
     The theorem for variables has an additional hypothesis about
     the variable being in the computation state with a certain type,
     which serves to establish the assertion about the type.")
   (xdoc::p
    "The theorems make use of @(tsee b*) bindings
     to keep them more readable.
     The theorems include additional hypotheses, in some cases,
     to ensure that the constructs in question are amenable to
     our formal dynamic semantics of C, which currently only covers a subset.")
   (xdoc::p
    "The theorems include hypotheses about
     the execution of the old construct not yielding an error,
     and in some cases about
     the execution of the sub-constructs of the new construct
     (not the new construct itself) not yielding an error);
     they also include hypotheses about
     the sub-constructs yielding the same results.
     While in some cases the equality of the results of the sub-constructs
     and the hypotheses that the old construct does not yield an error
     imply already that the sub-constructs do not yield an error
     (also see @(see exec-error-theorems)),
     this is not quite the case for (pure) expressions,
     which return expression values of type @(tsee c::expr-value).
     For flexibility, the theorems require the equality, for sub-expressions,
     not of their full expression values,
     but just for the values of those expression values
     (i.e. @(tsee c::expr-value->value)).
     Thus, we need explicit hypotheses that
     the expression values are not errors,
     because they are not readily implied by the equality of
     the values alone of the expression values.
     The flexibility is important, for instance,
     to handle the semantic equality of @('x + 0') and @('x'),
     which return different expression values (but the same values),
     because @('x') is an lvalue while @('x + 0') is not.")
   (xdoc::p
    "The theorems conclude that the new construct's execution
     does not yield an error either,
     and that its results are the same as the old construct's execution's.
     When these theorems are used in proof generation,
     the hypotheses about the new sub-constructs not yielding errors
     and about them returning the same results as the old ones
     are established via the proofs generated for the sub-constructs;
     and the conclusions serve for larger constructs, compositionally.")
   (xdoc::p
    "For non-strict constructs,
     we have multiple theorems,
     corresponding to which sub-constructs are actually executed.")
   (xdoc::p
    "For the C dynamic semantics execution functions
     that depend on function environments,
     we use potentially different function environments
     for the old vs. new constructs.
     We always use the same initial computation state
     for old and new constructs."))

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

  (defruled expr-ident-congruence
    (b* ((expr (c::expr-ident var))
         ((mv old-eval old-compst) (c::exec-expr expr compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr expr compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval)))
      (implies (and (not (c::errorp old-eval))
                    (c::compustate-has-var-with-type-p var type compst))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val) (c::type-fix type)))))
    :enable (c::exec-expr
             c::exec-ident
             c::compustate-has-var-with-type-p))

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

  (defruled expr-const-congruence
    (b* ((expr (c::expr-const const))
         ((mv old-eval old-compst) (c::exec-expr expr compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr expr compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (iconst (c::const-int->get const))
         (type (c::check-iconst iconst)))
      (implies (and (equal (c::const-kind const) :int)
                    (c::typep type)
                    (not (c::errorp old-eval)))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val) type))))
    :enable (c::exec-expr
             c::exec-const
             c::eval-const
             c::eval-iconst
             c::check-iconst
             c::type-of-value)
    :disable ((:e tau-system))) ; for speed

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

  (defruledl c::lognot-value-lemma
    (implies (and (c::valuep val)
                  (member-equal (c::value-kind val)
                                '(:uchar :schar
                                  :ushort :sshort
                                  :uint :sint
                                  :ulong :slong
                                  :ullong :sllong)))
             (equal (c::value-kind (c::lognot-value val)) :sint))
    :enable (c::lognot-value
             c::lognot-scalar-value
             c::lognot-integer-value
             c::value-scalarp
             c::value-arithmeticp
             c::value-realp
             c::value-integerp
             c::value-signed-integerp
             c::value-unsigned-integerp))

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

  (defruled expr-unary-congruence
    (b* ((old (c::expr-unary op old-arg))
         (new (c::expr-unary op new-arg))
         ((mv old-arg-eval old-arg-compst)
          (c::exec-expr old-arg compst old-fenv (1- limit)))
         ((mv new-arg-eval new-arg-compst)
          (c::exec-expr new-arg compst new-fenv (1- limit)))
         (old-arg-val (c::expr-value->value old-arg-eval))
         (new-arg-val (c::expr-value->value new-arg-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type (c::type-of-value old-arg-val)))
      (implies (and (c::unop-nonpointerp op)
                    (not (c::errorp old-eval))
                    (not (c::errorp new-arg-eval))
                    (iff old-arg-eval new-arg-eval)
                    (equal old-arg-val new-arg-val)
                    (equal old-arg-compst new-arg-compst)
                    (c::type-nonchar-integerp type))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val)
                           (if (equal (c::unop-kind op) :lognot)
                               (c::type-sint)
                             (c::promote-type type))))))
    :expand ((c::exec-expr (c::expr-unary op old-arg) compst old-fenv limit)
             (c::exec-expr (c::expr-unary op new-arg) compst new-fenv limit))
    :disable ((:e c::type-sint))
    :enable (c::unop-nonpointerp
             c::exec-unary
             c::eval-unary
             c::apconvert-expr-value-when-not-array
             c::value-arithmeticp
             c::value-realp
             c::value-integerp
             c::value-signed-integerp
             c::value-unsigned-integerp
             c::value-kind-not-array-when-value-integerp
             c::lognot-value-lemma))

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

  (defruled expr-cast-congruence
    (b* ((old (c::expr-cast tyname old-arg))
         (new (c::expr-cast tyname new-arg))
         ((mv old-arg-eval old-arg-compst)
          (c::exec-expr old-arg compst old-fenv (1- limit)))
         ((mv new-arg-eval new-arg-compst)
          (c::exec-expr new-arg compst new-fenv (1- limit)))
         (old-arg-val (c::expr-value->value old-arg-eval))
         (new-arg-val (c::expr-value->value new-arg-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type (c::type-of-value old-arg-val))
         (type1 (c::tyname-to-type tyname)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-arg-eval))
                    (iff old-arg-eval new-arg-eval)
                    (equal old-arg-val new-arg-val)
                    (equal old-arg-compst new-arg-compst)
                    (c::type-nonchar-integerp type)
                    (c::type-nonchar-integerp type1))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val)
                           type1))))
    :expand ((c::exec-expr (c::expr-cast tyname old-arg) compst old-fenv limit)
             (c::exec-expr (c::expr-cast tyname new-arg) compst new-fenv limit))
    :enable (c::exec-cast
             c::eval-cast
             c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-pure-strict-congruence
    (b* ((old (c::expr-binary op old-arg1 old-arg2))
         (new (c::expr-binary op new-arg1 new-arg2))
         ((mv old-arg1-eval old-arg1-compst)
          (c::exec-expr old-arg1 compst old-fenv (1- limit)))
         ((mv old-arg2-eval old-arg2-compst)
          (c::exec-expr old-arg2 old-arg1-compst old-fenv (1- limit)))
         ((mv new-arg1-eval new-arg1-compst)
          (c::exec-expr new-arg1 compst new-fenv (1- limit)))
         ((mv new-arg2-eval new-arg2-compst)
          (c::exec-expr new-arg2 new-arg1-compst new-fenv (1- limit)))
         (old-arg1-val (c::expr-value->value old-arg1-eval))
         (old-arg2-val (c::expr-value->value old-arg2-eval))
         (new-arg1-val (c::expr-value->value new-arg1-eval))
         (new-arg2-val (c::expr-value->value new-arg2-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type1 (c::type-of-value old-arg1-val))
         (type2 (c::type-of-value old-arg2-val)))
      (implies (and (c::binop-purep op)
                    (c::binop-strictp op)
                    (c::expr-purep new-arg1)
                    (c::expr-purep new-arg2)
                    (not (c::errorp old-eval))
                    (not (c::errorp new-arg1-eval))
                    (not (c::errorp new-arg2-eval))
                    (iff old-arg1-eval new-arg1-eval)
                    (iff old-arg2-eval new-arg2-eval)
                    (equal old-arg1-val new-arg1-val)
                    (equal old-arg2-val new-arg2-val)
                    (equal old-arg1-compst new-arg1-compst)
                    (equal old-arg2-compst new-arg2-compst)
                    (c::type-nonchar-integerp type1)
                    (c::type-nonchar-integerp type2))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val)
                           (cond ((member-equal (c::binop-kind op)
                                                '(:mul :div :rem :add :sub
                                                  :bitand :bitxor :bitior))
                                  (c::uaconvert-types type1 type2))
                                 ((member-equal (c::binop-kind op)
                                                '(:shl :shr))
                                  (c::promote-type type1))
                                 (t (c::type-sint)))))))
    :expand ((c::exec-expr
              (c::expr-binary op old-arg1 old-arg2) compst old-fenv limit)
             (c::exec-expr
              (c::expr-binary op new-arg1 new-arg2) compst new-fenv limit))
    :disable ((:e c::type-sint))
    :enable (c::binop-purep
             c::binop-strictp
             c::exec-binary-strict-pure
             c::eval-binary-strict-pure
             c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-logand-first-congruence
    (b* ((old (c::expr-binary (c::binop-logand) old-arg1 old-arg2))
         (new (c::expr-binary (c::binop-logand) new-arg1 new-arg2))
         ((mv old-arg1-eval old-arg1-compst)
          (c::exec-expr old-arg1 compst old-fenv (1- limit)))
         ((mv new-arg1-eval new-arg1-compst)
          (c::exec-expr new-arg1 compst new-fenv (1- limit)))
         (old-arg1-val (c::expr-value->value old-arg1-eval))
         (new-arg1-val (c::expr-value->value new-arg1-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type1 (c::type-of-value old-arg1-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-arg1-eval))
                    (iff old-arg1-eval new-arg1-eval)
                    (equal old-arg1-val new-arg1-val)
                    (equal old-arg1-compst new-arg1-compst)
                    (c::type-nonchar-integerp type1)
                    (not (c::test-value old-arg1-val)))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) (c::type-sint)))))
    :expand ((c::exec-expr (c::expr-binary '(:logand) old-arg1 old-arg2)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-binary '(:logand) new-arg1 new-arg2)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-logand-second-congruence
    (b* ((old (c::expr-binary (c::binop-logand) old-arg1 old-arg2))
         (new (c::expr-binary (c::binop-logand) new-arg1 new-arg2))
         ((mv old-arg1-eval old-arg1-compst)
          (c::exec-expr old-arg1 compst old-fenv (1- limit)))
         ((mv old-arg2-eval old-arg2-compst)
          (c::exec-expr old-arg2 old-arg1-compst old-fenv (1- limit)))
         ((mv new-arg1-eval new-arg1-compst)
          (c::exec-expr new-arg1 compst new-fenv (1- limit)))
         ((mv new-arg2-eval new-arg2-compst)
          (c::exec-expr new-arg2 new-arg1-compst new-fenv (1- limit)))
         (old-arg1-val (c::expr-value->value old-arg1-eval))
         (old-arg2-val (c::expr-value->value old-arg2-eval))
         (new-arg1-val (c::expr-value->value new-arg1-eval))
         (new-arg2-val (c::expr-value->value new-arg2-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type1 (c::type-of-value old-arg1-val))
         (type2 (c::type-of-value old-arg2-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-arg1-eval))
                    (not (c::errorp new-arg2-eval))
                    (iff old-arg1-eval new-arg1-eval)
                    (iff old-arg2-eval new-arg2-eval)
                    (equal old-arg1-val new-arg1-val)
                    (equal old-arg2-val new-arg2-val)
                    (equal old-arg1-compst new-arg1-compst)
                    (equal old-arg2-compst new-arg2-compst)
                    (c::type-nonchar-integerp type1)
                    (c::type-nonchar-integerp type2)
                    (c::test-value old-arg1-val))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) (c::type-sint)))))
    :expand ((c::exec-expr (c::expr-binary '(:logand) old-arg1 old-arg2)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-binary '(:logand) new-arg1 new-arg2)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-logor-first-congruence
    (b* ((old (c::expr-binary (c::binop-logor) old-arg1 old-arg2))
         (new (c::expr-binary (c::binop-logor) new-arg1 new-arg2))
         ((mv old-arg1-eval old-arg1-compst)
          (c::exec-expr old-arg1 compst old-fenv (1- limit)))
         ((mv new-arg1-eval new-arg1-compst)
          (c::exec-expr new-arg1 compst new-fenv (1- limit)))
         (old-arg1-val (c::expr-value->value old-arg1-eval))
         (new-arg1-val (c::expr-value->value new-arg1-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type1 (c::type-of-value old-arg1-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-arg1-eval))
                    (iff old-arg1-eval new-arg1-eval)
                    (equal old-arg1-val new-arg1-val)
                    (equal old-arg1-compst new-arg1-compst)
                    (c::type-nonchar-integerp type1)
                    (c::test-value old-arg1-val))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) (c::type-sint)))))
    :expand ((c::exec-expr (c::expr-binary '(:logor) old-arg1 old-arg2)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-binary '(:logor) new-arg1 new-arg2)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-logor-second-congruence
    (b* ((old (c::expr-binary (c::binop-logor) old-arg1 old-arg2))
         (new (c::expr-binary (c::binop-logor) new-arg1 new-arg2))
         ((mv old-arg1-eval old-arg1-compst)
          (c::exec-expr old-arg1 compst old-fenv (1- limit)))
         ((mv old-arg2-eval old-arg2-compst)
          (c::exec-expr old-arg2 old-arg1-compst old-fenv (1- limit)))
         ((mv new-arg1-eval new-arg1-compst)
          (c::exec-expr new-arg1 compst new-fenv (1- limit)))
         ((mv new-arg2-eval new-arg2-compst)
          (c::exec-expr new-arg2 new-arg1-compst new-fenv (1- limit)))
         (old-arg1-val (c::expr-value->value old-arg1-eval))
         (old-arg2-val (c::expr-value->value old-arg2-eval))
         (new-arg1-val (c::expr-value->value new-arg1-eval))
         (new-arg2-val (c::expr-value->value new-arg2-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type1 (c::type-of-value old-arg1-val))
         (type2 (c::type-of-value old-arg2-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-arg1-eval))
                    (not (c::errorp new-arg2-eval))
                    (iff old-arg1-eval new-arg1-eval)
                    (iff old-arg2-eval new-arg2-eval)
                    (equal old-arg1-val new-arg1-val)
                    (equal old-arg2-val new-arg2-val)
                    (equal old-arg1-compst new-arg1-compst)
                    (equal old-arg2-compst new-arg2-compst)
                    (c::type-nonchar-integerp type1)
                    (c::type-nonchar-integerp type2)
                    (not (c::test-value old-arg1-val)))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) (c::type-sint)))))
    :expand ((c::exec-expr (c::expr-binary '(:logor) old-arg1 old-arg2)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-binary '(:logor) new-arg1 new-arg2)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-asg-congruence
    (b* ((old (c::expr-binary (c::binop-asg) (c::expr-ident var) old-arg))
         (new (c::expr-binary (c::binop-asg) (c::expr-ident var) new-arg))
         ((mv old-arg-eval old-arg-compst)
          (c::exec-expr old-arg compst old-fenv (1- limit)))
         ((mv new-arg-eval new-arg-compst)
          (c::exec-expr new-arg compst new-fenv (1- limit)))
         (old-arg-val (c::expr-value->value old-arg-eval))
         (new-arg-val (c::expr-value->value new-arg-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (val (c::read-object (c::objdesign-of-var var compst) compst))
         (type (c::type-of-value old-arg-val)))
      (implies (and (not (c::errorp val))
                    (not (c::errorp old-eval))
                    (not (c::errorp new-arg-eval))
                    (iff old-arg-eval new-arg-eval)
                    (equal old-arg-val new-arg-val)
                    (equal old-arg-compst new-arg-compst)
                    (c::type-nonchar-integerp type))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    old-eval
                    (equal (c::type-of-value old-val) type))))
    :enable (c::exec-expr
             c::expr-purep
             c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp)
    :expand ((c::exec-expr
              (c::expr-binary '(:asg) (c::expr-ident var) old-arg)
              compst old-fenv limit)
             (c::exec-expr
              (c::expr-binary '(:asg) (c::expr-ident var) new-arg)
              compst new-fenv limit)))

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

  (defruled expr-cond-true-congruence
    (b* ((old (c::expr-cond old-test old-then old-else))
         (new (c::expr-cond new-test new-then new-else))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv old-then-eval old-then-compst)
          (c::exec-expr old-then old-test-compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         ((mv new-then-eval new-then-compst)
          (c::exec-expr new-then new-test-compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (old-then-val (c::expr-value->value old-then-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         (new-then-val (c::expr-value->value new-then-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type-test (c::type-of-value old-test-val))
         (type-then (c::type-of-value old-then-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-test-eval))
                    (not (c::errorp new-then-eval))
                    (iff old-test-eval new-test-eval)
                    (iff old-then-eval new-then-eval)
                    (equal old-test-val new-test-val)
                    (equal old-then-val new-then-val)
                    (equal old-test-compst new-test-compst)
                    (equal old-then-compst new-then-compst)
                    (c::type-nonchar-integerp type-test)
                    (c::type-nonchar-integerp type-then)
                    (c::test-value old-test-val))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) type-then))))
    :expand ((c::exec-expr (c::expr-cond old-test old-then old-else)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-cond new-test new-then new-else)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-cond-false-congruence
    (b* ((old (c::expr-cond old-test old-then old-else))
         (new (c::expr-cond new-test new-then new-else))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv old-else-eval old-else-compst)
          (c::exec-expr old-else old-test-compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         ((mv new-else-eval new-else-compst)
          (c::exec-expr new-else new-test-compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (old-else-val (c::expr-value->value old-else-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         (new-else-val (c::expr-value->value new-else-eval))
         ((mv old-eval old-compst) (c::exec-expr old compst old-fenv limit))
         ((mv new-eval new-compst) (c::exec-expr new compst new-fenv limit))
         (old-val (c::expr-value->value old-eval))
         (new-val (c::expr-value->value new-eval))
         (type-test (c::type-of-value old-test-val))
         (type-else (c::type-of-value old-else-val)))
      (implies (and (not (c::errorp old-eval))
                    (not (c::errorp new-test-eval))
                    (not (c::errorp new-else-eval))
                    (iff old-test-eval new-test-eval)
                    (iff old-else-eval new-else-eval)
                    (equal old-test-val new-test-val)
                    (equal old-else-val new-else-val)
                    (equal old-test-compst new-test-compst)
                    (equal old-else-compst new-else-compst)
                    (c::type-nonchar-integerp type-test)
                    (c::type-nonchar-integerp type-else)
                    (not (c::test-value old-test-val)))
               (and (not (c::errorp new-eval))
                    (iff old-eval new-eval)
                    (equal old-val new-val)
                    (equal old-compst new-compst)
                    (equal (c::type-of-value old-val) type-else))))
    :expand ((c::exec-expr (c::expr-cond old-test old-then old-else)
                           compst old-fenv limit)
             (c::exec-expr (c::expr-cond new-test new-then new-else)
                           compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled initer-single-congruence
    (b* ((old (c::initer-single old-expr))
         (new (c::initer-single new-expr))
         ((mv old-expr-eval old-expr-compst)
          (c::exec-expr old-expr compst old-fenv (1- limit)))
         ((mv new-expr-eval new-expr-compst)
          (c::exec-expr new-expr compst new-fenv (1- limit)))
         (old-expr-val (c::expr-value->value old-expr-eval))
         (new-expr-val (c::expr-value->value new-expr-eval))
         ((mv old-ival old-compst)
          (c::exec-initer old compst old-fenv limit))
         ((mv new-ival new-compst)
          (c::exec-initer new compst new-fenv limit))
         (type (c::type-of-value old-expr-val)))
      (implies (and (not (c::errorp old-ival))
                    (not (c::errorp new-expr-eval))
                    (iff old-expr-eval new-expr-eval)
                    (equal old-expr-val new-expr-val)
                    (equal old-expr-compst new-expr-compst)
                    (c::type-nonchar-integerp type))
               (and (not (c::errorp new-ival))
                    (equal old-ival new-ival)
                    (equal old-compst new-compst)
                    (equal (c::init-type-of-init-value old-ival)
                           (c::init-type-single type)))))
    :expand ((c::exec-initer (c::initer-single old-expr) compst old-fenv limit)
             (c::exec-initer (c::initer-single new-expr) compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp
             c::init-type-of-init-value))

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

  (defruled stmt-null-congruence
    (b* ((old (c::stmt-null))
         (new (c::stmt-null))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (not (c::errorp old-sval))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil nil)))))
    :enable c::exec-stmt)

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

  (defruled stmt-expr-congruence
    (b* ((old (c::stmt-expr old-expr))
         (new (c::stmt-expr new-expr))
         ((mv old-expr-eval old-expr-compst)
          (c::exec-expr old-expr compst old-fenv (- limit 1)))
         ((mv new-expr-eval new-expr-compst)
          (c::exec-expr new-expr compst new-fenv (- limit 1)))
         (old-expr-val (c::expr-value->value old-expr-eval))
         (new-expr-val (c::expr-value->value new-expr-eval))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (not (c::errorp new-expr-eval))
                    (iff old-expr-eval new-expr-eval)
                    (equal old-expr-val new-expr-val)
                    (equal old-expr-compst new-expr-compst))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil nil)))))
    :expand ((c::exec-stmt (c::stmt-expr old-expr) compst old-fenv limit)
             (c::exec-stmt (c::stmt-expr new-expr) compst new-fenv limit)))

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

  (defruled stmt-return-value-congruence
    (b* ((old (c::stmt-return old-expr))
         (new (c::stmt-return new-expr))
         ((mv old-expr-eval old-expr-compst)
          (c::exec-expr old-expr compst old-fenv (1- limit)))
         ((mv new-expr-eval new-expr-compst)
          (c::exec-expr new-expr compst new-fenv (1- limit)))
         (old-expr-val (c::expr-value->value old-expr-eval))
         (new-expr-val (c::expr-value->value new-expr-eval))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit))
         (type (c::type-of-value old-expr-val)))
      (implies (and old-expr
                    new-expr
                    (not (c::errorp old-sval))
                    (not (c::errorp new-expr-eval))
                    (iff old-expr-eval new-expr-eval)
                    (equal old-expr-val new-expr-val)
                    (equal old-expr-compst new-expr-compst)
                    (c::type-nonchar-integerp type))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (equal (c::stmt-value-kind old-sval) :return)
                    (c::stmt-value-return->value? old-sval)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert type nil)))))
    :expand ((c::exec-stmt (c::stmt-return old-expr) compst old-fenv limit)
             (c::exec-stmt (c::stmt-return new-expr) compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp
             c::type-option-of-stmt-value
             c::type-of-value-option
             c::value-option-some->val))

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

  (defruled stmt-return-novalue-congruence
    (b* ((old (c::stmt-return nil))
         (new (c::stmt-return nil))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (not (c::errorp old-sval))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (equal (c::stmt-value-kind old-sval) :return)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert (c::type-void) nil)))))
    :enable c::exec-stmt)

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

  (defruled stmt-if-true-congruence
    (b* ((old (c::stmt-if old-test old-then))
         (new (c::stmt-if new-test new-then))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         ((mv old-then-sval old-then-compst)
          (c::exec-stmt old-then old-test-compst old-fenv (1- limit)))
         ((mv new-then-sval new-then-compst)
          (c::exec-stmt new-then new-test-compst new-fenv (1- limit)))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit))
         (type (c::type-of-value old-test-val)))
      (implies (and (not (c::errorp old-sval))
                    (not (c::errorp new-test-eval))
                    (not (c::errorp new-then-sval))
                    (iff old-test-eval new-test-eval)
                    (equal old-test-val new-test-val)
                    (equal old-test-compst new-test-compst)
                    (equal old-then-sval new-then-sval)
                    (equal old-then-compst new-then-compst)
                    (c::test-value old-test-val)
                    (c::type-nonchar-integerp type)
                    (set::in (c::type-option-of-stmt-value old-then-sval)
                             types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             types))))
    :expand ((c::exec-stmt
              (c::stmt-if old-test old-then) compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-if new-test new-then) compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-if-false-congruence
    (b* ((old (c::stmt-if old-test old-then))
         (new (c::stmt-if new-test new-then))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit))
         (type (c::type-of-value old-test-val)))
      (implies (and (not (c::errorp old-sval))
                    (not (c::errorp new-test-eval))
                    (iff old-test-eval new-test-eval)
                    (equal old-test-val new-test-val)
                    (equal old-test-compst new-test-compst)
                    (not (c::test-value old-test-val))
                    (c::type-nonchar-integerp type))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil nil)))))
    :expand ((c::exec-stmt
              (c::stmt-if old-test old-then) compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-if new-test new-then) compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-ifelse-true-congruence
    (b* ((old (c::stmt-ifelse old-test old-then old-else))
         (new (c::stmt-ifelse new-test new-then new-else))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         ((mv old-then-sval old-then-compst)
          (c::exec-stmt old-then old-test-compst old-fenv (1- limit)))
         ((mv new-then-sval new-then-compst)
          (c::exec-stmt new-then new-test-compst new-fenv (1- limit)))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit))
         (type (c::type-of-value old-test-val)))
      (implies (and (not (c::errorp old-sval))
                    (not (c::errorp new-test-eval))
                    (not (c::errorp new-then-sval))
                    (iff old-test-eval new-test-eval)
                    (equal old-test-val new-test-val)
                    (equal old-test-compst new-test-compst)
                    (equal old-then-sval new-then-sval)
                    (equal old-then-compst new-then-compst)
                    (c::test-value old-test-val)
                    (c::type-nonchar-integerp type)
                    (set::in (c::type-option-of-stmt-value old-then-sval)
                             types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             types))))
    :expand ((c::exec-stmt
              (c::stmt-ifelse old-test old-then old-else)
              compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-ifelse new-test new-then new-else)
              compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-ifelse-false-congruence
    (b* ((old (c::stmt-ifelse old-test old-then old-else))
         (new (c::stmt-ifelse new-test new-then new-else))
         ((mv old-test-eval old-test-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((mv new-test-eval new-test-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         (old-test-val (c::expr-value->value old-test-eval))
         (new-test-val (c::expr-value->value new-test-eval))
         ((mv old-else-sval old-else-compst)
          (c::exec-stmt old-else old-test-compst old-fenv (1- limit)))
         ((mv new-else-sval new-else-compst)
          (c::exec-stmt new-else new-test-compst new-fenv (1- limit)))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit))
         (type (c::type-of-value old-test-val)))
      (implies (and (not (c::errorp old-sval))
                    (not (c::errorp new-test-eval))
                    (not (c::errorp new-else-sval))
                    (iff old-test-eval new-test-eval)
                    (equal old-test-val new-test-val)
                    (equal old-test-compst new-test-compst)
                    (equal old-else-sval new-else-sval)
                    (equal old-else-compst new-else-compst)
                    (not (c::test-value old-test-val))
                    (c::type-nonchar-integerp type)
                    (set::in (c::type-option-of-stmt-value old-else-sval)
                             types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             types))))
    :expand ((c::exec-stmt
              (c::stmt-ifelse old-test old-then old-else)
              compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-ifelse new-test new-then new-else)
              compst new-fenv limit))
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-compound-congruence
    (b* ((old (c::stmt-compound old-items))
         (new (c::stmt-compound new-items))
         (compst1 (c::enter-scope compst))
         ((mv old-items-sval old-items-compst)
          (c::exec-block-item-list old-items compst1 old-fenv (1- limit)))
         ((mv new-items-sval new-items-compst)
          (c::exec-block-item-list new-items compst1 new-fenv (1- limit)))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (equal old-items-sval new-items-sval)
                    (equal old-items-compst new-items-compst)
                    (set::in (c::type-option-of-stmt-value old-items-sval)
                             types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             types))))
    :expand ((c::exec-stmt (c::stmt-compound old-items) compst old-fenv limit)
             (c::exec-stmt (c::stmt-compound new-items) compst new-fenv limit)))

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

  (defruled declon-declon-congruence
    (b* ((declor (c::obj-declor-ident var))
         (old (c::obj-declon (c::scspecseq-none) tyspecs declor old-initer))
         (new (c::obj-declon (c::scspecseq-none) tyspecs declor new-initer))
         ((mv old-init-ival old-init-compst)
          (c::exec-initer old-initer compst old-fenv (1- limit)))
         ((mv new-init-ival new-init-compst)
          (c::exec-initer new-initer compst new-fenv (1- limit)))
         (old-compst (c::exec-obj-declon old compst old-fenv limit))
         (new-compst (c::exec-obj-declon new compst new-fenv limit)))
      (implies (and old-initer
                    new-initer
                    (not (c::errorp old-compst))
                    (equal old-init-ival new-init-ival)
                    (equal old-init-compst new-init-compst))
               (and (not (c::errorp new-compst))
                    (equal old-compst new-compst))))
    :expand ((c::exec-obj-declon
              (c::obj-declon
               '(:none) tyspecs (c::obj-declor-ident var) old-initer)
              compst old-fenv limit)
             (c::exec-obj-declon
              (c::obj-declon
               '(:none) tyspecs (c::obj-declor-ident var) new-initer)
              compst new-fenv limit))
    :enable (c::obj-declon-to-ident+scspec+tyname+init))

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

  (defruled block-item-stmt-congruence
    (b* ((old (c::block-item-stmt old-stmt))
         (new (c::block-item-stmt new-stmt))
         ((mv old-stmt-sval old-stmt-compst)
          (c::exec-stmt old-stmt compst old-fenv (1- limit)))
         ((mv new-stmt-sval new-stmt-compst)
          (c::exec-stmt new-stmt compst new-fenv (1- limit)))
         ((mv old-sval old-compst)
          (c::exec-block-item old compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-block-item new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (equal old-stmt-sval new-stmt-sval)
                    (equal old-stmt-compst new-stmt-compst)
                    (set::in (c::type-option-of-stmt-value old-stmt-sval)
                             types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             types))))
    :expand
    ((c::exec-block-item (c::block-item-stmt old-stmt) compst old-fenv limit)
     (c::exec-block-item (c::block-item-stmt new-stmt) compst new-fenv limit)))

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

  (defruled block-item-declon-congruence
    (b* ((old (c::block-item-declon old-declon))
         (new (c::block-item-declon new-declon))
         (old-declon-compst
          (c::exec-obj-declon old-declon compst old-fenv (1- limit)))
         (new-declon-compst
          (c::exec-obj-declon new-declon compst new-fenv (1- limit)))
         ((mv old-sval old-compst)
          (c::exec-block-item old compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-block-item new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (equal old-declon-compst new-declon-compst))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil nil)))))
    :expand ((c::exec-block-item
              (c::block-item-declon old-declon) compst old-fenv limit)
             (c::exec-block-item
              (c::block-item-declon new-declon) compst new-fenv limit)))

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

  (defruled block-item-list-empty-congruence
    (b* ((old nil)
         (new nil)
         ((mv old-sval old-compst)
          (c::exec-block-item-list old compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-block-item-list new compst new-fenv limit)))
      (implies (not (c::errorp old-sval))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil nil)))))
    :enable c::exec-block-item-list)

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

  (defruled block-item-list-cons-first-congruence
    (b* ((old (cons old-item old-items))
         (new (cons new-item new-items))
         ((mv old-item-sval old-item-compst)
          (c::exec-block-item old-item compst old-fenv (1- limit)))
         ((mv new-item-sval new-item-compst)
          (c::exec-block-item new-item compst new-fenv (1- limit)))
         ((mv old-sval old-compst)
          (c::exec-block-item-list old compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-block-item-list new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (equal old-item-sval new-item-sval)
                    (equal old-item-compst new-item-compst)
                    (equal (c::stmt-value-kind old-item-sval) :return)
                    (set::in (c::type-option-of-stmt-value old-item-sval)
                             first-types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::union (set::delete nil first-types)
                                         rest-types)))))
    :expand ((c::exec-block-item-list
              (cons old-item old-items) compst old-fenv limit)
             (c::exec-block-item-list
              (cons new-item new-items) compst new-fenv limit))
    :enable c::type-option-of-stmt-value)

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

  (defruled block-item-list-cons-rest-congruence
    (b* ((old (cons old-item old-items))
         (new (cons new-item new-items))
         ((mv old-item-sval old-item-compst)
          (c::exec-block-item old-item compst old-fenv (1- limit)))
         ((mv new-item-sval new-item-compst)
          (c::exec-block-item new-item compst new-fenv (1- limit)))
         ((mv old-items-sval old-items-compst)
          (c::exec-block-item-list
           old-items old-item-compst old-fenv (1- limit)))
         ((mv new-items-sval new-items-compst)
          (c::exec-block-item-list
           new-items new-item-compst new-fenv (1- limit)))
         ((mv old-sval old-compst)
          (c::exec-block-item-list old compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-block-item-list new compst new-fenv limit)))
      (implies (and (not (c::errorp old-sval))
                    (equal old-item-sval new-item-sval)
                    (equal old-items-sval new-items-sval)
                    (equal old-item-compst new-item-compst)
                    (equal old-items-compst new-items-compst)
                    (equal (c::stmt-value-kind old-item-sval) :none)
                    (set::in (c::type-option-of-stmt-value old-item-sval)
                             first-types)
                    (set::in (c::type-option-of-stmt-value old-items-sval)
                             rest-types))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::union (set::delete nil first-types)
                                         rest-types)))))
    :expand ((c::exec-block-item-list
              (cons old-item old-items) compst old-fenv limit)
             (c::exec-block-item-list
              (cons new-item new-items) compst new-fenv limit))))

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

(defsection exec-error-theorems
  :short "Error theorems about execution."
  :long
  (xdoc::topstring
   (xdoc::p
    "These theorems say that
     if the execution of a sub-construct yields an error,
     so does the execution of the super-construct.")
   (xdoc::p
    "Transformations use these theorems in proof generation
     to actually show that if the super-construct does not yield an error,
     neither do its sub-constructs.")
   (xdoc::p
    "The theorem @('expr-pure-errors') is a little different,
     because it relates pure expression execution
     and general expression execution
     applied to the same expressions.
     But it has a similar flavor and structure as the other theorems."))

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

  (defruled expr-unary-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr arg compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-unary op arg) compst fenv limit))))
    :expand (c::exec-expr (c::expr-unary op arg) compst fenv limit))

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

  (defruled expr-cast-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr arg compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-cast tyname arg) compst fenv limit))))
    :expand (c::exec-expr (c::expr-cast tyname arg) compst fenv limit))

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

  (defruled expr-binary-pure-strict-errors
    (b* (((mv eval1 compst1) (c::exec-expr arg1 compst fenv (1- limit)))
         ((mv eval2 &) (c::exec-expr arg2 compst1 fenv (1- limit))))
      (implies (and (c::binop-strictp op)
                    (c::binop-purep op)
                    (or (c::errorp eval1)
                        (c::errorp eval2)))
               (c::errorp
                (mv-nth 0 (c::exec-expr
                           (c::expr-binary op arg1 arg2) compst fenv limit)))))
    :expand (c::exec-expr (c::expr-binary op arg1 arg2) compst fenv limit))

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

  (defruled expr-binary-logand-first-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr arg1 compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-binary (c::binop-logand) arg1 arg2)
                         compst fenv limit))))
    :expand (c::exec-expr
             (c::expr-binary '(:logand) arg1 arg2) compst fenv limit))

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

  (defruled expr-binary-logand-second-errors
    (b* (((mv eval compst1) (c::exec-expr arg1 compst fenv (1- limit))))
      (implies (and (not (c::errorp eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value eval)))
                    (c::test-value (c::expr-value->value eval))
                    (c::errorp
                     (mv-nth 0 (c::exec-expr arg2 compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-expr
                           (c::expr-binary (c::binop-logand) arg1 arg2)
                           compst fenv limit)))))
    :expand (c::exec-expr
             (c::expr-binary '(:logand) arg1 arg2) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-logor-first-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr arg1 compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-binary (c::binop-logor) arg1 arg2)
                         compst fenv limit))))
    :expand (c::exec-expr
             (c::expr-binary '(:logor) arg1 arg2) compst fenv limit))

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

  (defruled expr-binary-logor-second-errors
    (b* (((mv eval compst1) (c::exec-expr arg1 compst fenv (1- limit))))
      (implies (and (not (c::errorp eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value eval)))
                    (not (c::test-value (c::expr-value->value eval)))
                    (c::errorp
                     (mv-nth 0 (c::exec-expr arg2 compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-expr
                           (c::expr-binary (c::binop-logor) arg1 arg2)
                           compst fenv limit)))))
    :expand (c::exec-expr
             (c::expr-binary '(:logor) arg1 arg2) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-binary-asg-errors
    (implies (or (c::errorp
                  (mv-nth 0 (c::exec-expr
                             (c::expr-ident var) compst fenv (1- limit))))
                 (c::errorp
                  (mv-nth 0 (c::exec-expr expr compst fenv (1- limit)))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-binary
                          (c::binop-asg) (c::expr-ident var) expr)
                         compst fenv limit))))
    :enable (c::exec-expr
             c::expr-purep)
    :expand (c::exec-expr (c::expr-binary '(:asg) (c::expr-ident var) expr)
                          compst fenv limit))

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

  (defruled expr-cond-test-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr test compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-expr
                         (c::expr-cond test then else) compst fenv limit))))
    :expand (c::exec-expr (c::expr-cond test then else) compst fenv limit))

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

  (defruled expr-cond-then-errors
    (b* (((mv eval compst1) (c::exec-expr test compst fenv (1- limit))))
      (implies (and (not (c::errorp eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value eval)))
                    (c::test-value (c::expr-value->value eval))
                    (c::errorp
                     (mv-nth 0 (c::exec-expr then compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-expr
                           (c::expr-cond test then else) compst fenv limit)))))
    :expand (c::exec-expr
             (c::expr-cond test then else) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled expr-cond-else-errors
    (b* (((mv eval compst1) (c::exec-expr test compst fenv (1- limit))))
      (implies (and (not (c::errorp eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value eval)))
                    (not (c::test-value (c::expr-value->value eval)))
                    (c::errorp
                     (mv-nth 0 (c::exec-expr else compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-expr
                           (c::expr-cond test then else) compst fenv limit)))))
    :expand (c::exec-expr
             (c::expr-cond test then else) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled initer-single-errors
    (implies (c::errorp (mv-nth 0 (c::exec-expr expr compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-initer
                         (c::initer-single expr) compst fenv limit))))
    :expand (c::exec-initer (c::initer-single expr) compst fenv limit))

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

  (defruled stmt-expr-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr expr compst fenv (- limit 1))))
             (c::errorp
              (mv-nth 0 (c::exec-stmt (c::stmt-expr expr) compst fenv limit))))
    :expand (c::exec-stmt (c::stmt-expr expr) compst fenv limit)
    :enable c::exec-expr)

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

  (defruled stmt-return-errors
    (implies (and expr
                  (c::errorp
                   (mv-nth 0 (c::exec-expr expr compst fenv (1- limit)))))
             (c::errorp
              (mv-nth 0 (c::exec-stmt (c::stmt-return expr)
                                      compst
                                      fenv
                                      limit))))
    :expand (c::exec-stmt (c::stmt-return expr) compst fenv limit))

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

  (defruled stmt-if-test-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr test compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-stmt
                         (c::stmt-if test then) compst fenv limit))))
    :expand (c::exec-stmt (c::stmt-if test then) compst fenv limit))

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

  (defruled stmt-if-then-errors
    (b* (((mv test-eval compst1) (c::exec-expr test compst fenv (1- limit))))
      (implies (and (not (c::errorp test-eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value test-eval)))
                    (c::test-value (c::expr-value->value test-eval))
                    (c::errorp
                     (mv-nth 0 (c::exec-stmt then compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-stmt
                           (c::stmt-if test then) compst fenv limit)))))
    :expand (c::exec-stmt (c::stmt-if test then) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-ifelse-test-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-expr test compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-stmt
                         (c::stmt-ifelse test then else) compst fenv limit))))
    :expand (c::exec-stmt (c::stmt-ifelse test then else) compst fenv limit))

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

  (defruled stmt-ifelse-then-errors
    (b* (((mv test-eval compst1) (c::exec-expr test compst fenv (1- limit))))
      (implies (and (not (c::errorp test-eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value (c::expr-value->value test-eval)))
                    (c::test-value (c::expr-value->value test-eval))
                    (c::errorp
                     (mv-nth 0 (c::exec-stmt then compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-stmt
                           (c::stmt-ifelse test then else)
                           compst fenv limit)))))
    :expand (c::exec-stmt (c::stmt-ifelse test then else) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-ifelse-else-errors
    (b* (((mv test-eval compst1) (c::exec-expr test compst fenv (1- limit))))
      (implies (and (not (c::errorp test-eval))
                    (c::type-nonchar-integerp
                     (c::type-of-value
                      (c::expr-value->value test-eval)))
                    (not (c::test-value (c::expr-value->value test-eval)))
                    (c::errorp
                     (mv-nth 0 (c::exec-stmt else compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-stmt
                           (c::stmt-ifelse test then else)
                           compst fenv limit)))))
    :expand (c::exec-stmt (c::stmt-ifelse test then else) compst fenv limit)
    :enable (c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp))

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

  (defruled stmt-compound-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-block-item-list
                         items (c::enter-scope compst) fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-stmt
                         (c::stmt-compound items) compst fenv limit))))
    :expand (c::exec-stmt (c::stmt-compound items) compst fenv limit))

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

  (defruled declon-declon-errors
    (b* ((declor (c::obj-declor-ident var))
         (declon (c::obj-declon (c::scspecseq-none) tyspecs declor initer)))
      (implies (and initer
                    (c::errorp
                     (mv-nth 0 (c::exec-initer
                                initer compst fenv (1- limit)))))
               (c::errorp (c::exec-obj-declon declon compst fenv limit))))
    :expand (c::exec-obj-declon
             (c::obj-declon
              '(:none) tyspecs (c::obj-declor-ident var) initer)
             compst fenv limit)
    :enable c::obj-declon-to-ident+scspec+tyname+init)

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

  (defruled block-item-stmt-errors
    (implies (c::errorp (mv-nth 0 (c::exec-stmt stmt compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-block-item
                         (c::block-item-stmt stmt) compst fenv limit))))
    :expand (c::exec-block-item (c::block-item-stmt stmt) compst fenv limit))

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

  (defruled block-item-declon-errors
    (implies (c::errorp (c::exec-obj-declon declon compst fenv (1- limit)))
             (c::errorp (mv-nth 0 (c::exec-block-item
                                   (c::block-item-declon declon)
                                   compst fenv limit))))
    :expand (c::exec-block-item
             (c::block-item-declon declon) compst fenv limit))

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

  (defruled block-item-list-cons-first-errors
    (implies (c::errorp
              (mv-nth 0 (c::exec-block-item item compst fenv (1- limit))))
             (c::errorp
              (mv-nth 0 (c::exec-block-item-list
                         (cons item items) compst fenv limit))))
    :expand (c::exec-block-item-list (cons item items) compst fenv limit))

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

  (defruled block-item-list-cons-rest-errors
    (b* (((mv sval compst1) (c::exec-block-item item compst fenv (1- limit))))
      (implies (and (not (c::errorp sval))
                    (equal (c::stmt-value-kind sval) :none)
                    (c::errorp (mv-nth 0 (c::exec-block-item-list
                                          items compst1 fenv (1- limit)))))
               (c::errorp
                (mv-nth 0 (c::exec-block-item-list
                           (cons item items) compst fenv limit)))))
    :expand (c::exec-block-item-list (cons item items) compst fenv limit)))

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

(defsection exec-loop-theorems
  :short "Theorems about loop execution."
  :long
  (xdoc::topstring
   (xdoc::p
    "Loops need theorems similar to
     the congruence theorems in @(see exec-congruence-theorems),
     but since they involve proofs by induction,
     those theorems also combine the equivalent of
     the error theorems in @(see exec-error-theorems)
     and (in part) the variable theorems
     in @(see exec-compustate-vars-theorems),
     because those facts participate in the induction.
     This is why we use the generic term @('exec-loop-theorems') here.")
   (xdoc::p
    "For now we only support @('while') loops,
     but other kinds of loops should be analogous.
     We start by explaining @('while') loops.")
   (xdoc::p
    "The starting point to understand these theorems and their proofs
     is that we want something like the aforementioned congruence theorems:
     if the execution of the old test and new test are equivalent,
     and the execution of the old body and new body are equivalent,
     then the execution of the old loop and new loop are equivalent.
     But the execution of the loop may take zero or more iterations,
     so the proof is by induction.")
   (xdoc::p
    "Although @(tsee c::exec-stmt-while) has a recursive structure,
     it is mutually recursive with the other execution functions.
     Additionally, @(tsee c::exec-stmt-while) operates
     on a single test and body of a single loop,
     while here we have two loops (and tests and bodies).
     So we need a custom induction scheme,
     captured by the function @('while-induct') below,
     which has a singly recursive structure
     similar to @(tsee c::exec-stmt-while),
     but involving two tests and bodies,
     and also two function environments.
     But it has only one computation state,
     because the idea behind the congruence is that
     the two loops start in the same computation states,
     and stay in the same computation states.
     We ``force'' this equality, as well as the equality of the tests,
     by stopping the recursion in @('while-induct')
     if those are not equal.
     We also need a single limit,
     because the two executions are synchronized.
     The recursion of @('while-induct') stops as soon as
     some of the early-exit tests in @(tsee c::exec-stmt-while) fails.
     The only difference with @(tsee c::exec-stmt-while) is that
     we avoid the array-to-pointer conversion and its check
     by checking that the test yields an integer value.")
   (xdoc::p
    "The congruence theorems in @(see exec-congruence-theorems)
     have hypotheses about the execution of
     the sub-constructs of the construct of interest,
     starting with the same computation state @('compst'),
     and possibly involving a second computation state
     between the execution of a sub-construct
     and the execution of another sub-construct
     (e.g. see @('block-item-list-cons-rest-congruence')).
     If we attempted to do the same for loops,
     with test and body as the sub-constructs,
     we would run into trouble with the induction hypothesis,
     which would involve different computation states.
     Intuitively, the issue is that we want to show that
     the executions of the two loops remain ``synchronized''
     for a varying number of iterations,
     i.e. not just starting from the @('compst') computation state
     at the beginning of the loop.
     What we need is the fact that the executions of the tests and bodies
     are equivalent for every possible starting computation state,
     not just the specific @('compst') used in the theorem we want to prove.
     Indeed, in the bottom-up proof of theorems in our transformations,
     the equivalence theorems proved for tests and bodies
     are implicitly universally quantified.
     But we need to explicate the universal quantification
     in the hypotheses of the theorem we want to prove here.")
   (xdoc::p
    "This justifies the universally quantified predicates
     @('while-test-hyp') and @('while-body-hyp') defined below,
     whose names indicate that they are used as hypotheses,
     in the theorem we prove about loops.
     The predicate for the test asserts,
     for all possible computation states,
     the equivalence of the tests;
     the predicate for the body asserts,
     for all possible computation states and limits,
     the equivalence of the bodies.
     Since, in general, our generated theorems include hypotheses
     about certain variables in the computation state with certain types,
     we parameterize the predicates over a map from identifiers to types,
     to capture such variables and their types.
     We use @(tsee c::compustate-has-vars-with-types-p),
     with that variable-type map,
     as hypothesis in the quantified predicates,
     and also as conclusion in the quantified predicate for the body;
     the hypothesis is needed to show the satisfaction of the predicates
     (in the theorems generated by the transformation),
     and the conclusion is needed to support the induction, for the body.
     The quantified predicate for the body is also parameterized by
     the set of optional types that can be returned by the loop bodies.")
   (xdoc::p
    "With @('while-test-hyp') and @('while-body-hyp') as hypotheses,
     we prove, by induction,
     the desired theorem about @(tsee c::exec-stmt-while).
     We need a few rules to handle the array-to-pointer conversion,
     but the proof hints are otherwise unremarkable.
     The @('while-test-hyp-necc') and @('while-body-hyp-necc') theorems
     are instantiated for the induction hypothesis.
     Note that the theorem has @(tsee c::compustate-has-vars-with-types-p)
     as both hypothesis and conclusion, matching @('while-body-hyp').")
   (xdoc::p
    "From the theorem about @(tsee c::exec-stmt-while),
     we prove the desired one, about @(tsee c::exec-stmt)
     applied to a @('while') loop.
     This does not incluce the conclusion about
     the variables in the computation state with certain types,
     because we can just use the rule @('stmt-compustate-vars') for that.
     This theorem also handles the errors,
     so we do not need a separate theorem for that.")
   (xdoc::p
    "The theorems proved here make no claims about the loop terminating.
     The theorems say that, if the loop terminates,
     then it yields equivalent results for old and new code.
     If the loop fails to terminate,
     @(tsee c::exec-stmt-while), and thus @(tsee c::exec-stmt)
     returns an error due to the limit being exhausted,
     but the theorems deny that as hypothesis.")
   (xdoc::p
    "The handling of @('do-while') loops is analogous to
     the handling of @('while') loops, explained above.
     There are a few more complications which just come from the fact that
     we are more accurately modeling the execution of @('do-while') loop
     to reflect the fact that both the loops and their bodies are blocks;
     in contrast, our model of @('while') loop currently miss that
     (see documentation of @(tsee c::exec-stmt)).
     But we plan to extend our model of @('while') loops to have that too,
     at which point there should be even fewer differences,
     in the theorems here, between the two kinds of loops."))

  ;; while:

  (defund while-induct (old-test
                        new-test
                        old-body
                        new-body
                        old-fenv
                        new-fenv
                        compst
                        limit)
    (declare (xargs :measure (nfix limit)
                    :hints (("Goal" :in-theory (enable nfix o< o-finp)))))
    (b* (((when (zp limit)) nil)
         ((mv old-test-eval old-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((when (c::errorp old-test-eval)) nil)
         ((unless old-test-eval) nil)
         ((mv new-test-eval new-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         ((when (c::errorp new-test-eval)) nil)
         ((unless new-test-eval) nil)
         ((unless (equal old-compst new-compst)) nil)
         (compst old-compst)
         (old-test-val (c::expr-value->value old-test-eval))
         ((unless (c::type-nonchar-integerp (c::type-of-value old-test-val)))
          nil)
         (new-test-val (c::expr-value->value new-test-eval))
         ((unless (c::type-nonchar-integerp (c::type-of-value new-test-val)))
          nil)
         ((unless (equal old-test-val new-test-val)) nil)
         (old-continuep (c::test-value old-test-val))
         ((when (c::errorp old-continuep)) nil)
         (new-continuep (c::test-value new-test-val))
         ((when (c::errorp new-continuep)) nil)
         ((when (not old-continuep)) nil)
         ((when (not new-continuep)) nil)
         ((mv old-sval old-compst)
          (c::exec-stmt old-body compst old-fenv (1- limit)))
         ((when (c::errorp old-sval)) nil)
         ((mv new-sval new-compst)
          (c::exec-stmt new-body compst new-fenv (1- limit)))
         ((when (c::errorp new-sval)) nil)
         ((when (c::stmt-value-case old-sval :return)) nil)
         ((when (c::stmt-value-case new-sval :return)) nil)
         ((unless (equal old-compst new-compst)) nil))
      (while-induct old-test
                    new-test
                    old-body
                    new-body
                    old-fenv
                    new-fenv
                    old-compst
                    (1- limit))))

  (defund-sk while-test-hyp (old-test new-test old-fenv new-fenv vartys)
    (forall (compst limit)
            (b* (((mv old-test-eval old-test-compst)
                  (c::exec-expr old-test compst old-fenv limit))
                 ((mv new-test-eval new-test-compst)
                  (c::exec-expr new-test compst new-fenv limit))
                 (old-test-val (c::expr-value->value old-test-eval))
                 (new-test-val (c::expr-value->value new-test-eval)))
              (implies (and (> (c::compustate-frames-number compst) 0)
                            (c::compustate-has-vars-with-types-p vartys compst)
                            (not (c::errorp old-test-eval))
                            old-test-eval)
                       (and (not (c::errorp new-test-eval))
                            new-test-eval
                            (equal old-test-val new-test-val)
                            (equal old-test-compst new-test-compst)
                            (c::type-nonchar-integerp
                             (c::type-of-value old-test-val)))))))

  (defund-sk while-body-hyp (old-body new-body old-fenv new-fenv types vartys)
    (forall (compst limit)
            (b* (((mv old-body-sval old-body-compst)
                  (c::exec-stmt old-body compst old-fenv limit))
                 ((mv new-body-sval new-body-compst)
                  (c::exec-stmt new-body compst new-fenv limit)))
              (implies (and (> (c::compustate-frames-number compst) 0)
                            (c::compustate-has-vars-with-types-p vartys compst)
                            (not (c::errorp old-body-sval)))
                       (and (not (c::errorp new-body-sval))
                            (equal old-body-sval new-body-sval)
                            (equal old-body-compst new-body-compst)
                            (set::in
                             (c::type-option-of-stmt-value old-body-sval)
                             types)
                            (c::compustate-has-vars-with-types-p
                             vartys old-body-compst))))))

  (defruled stmt-while-loop-theorem
    (b* (((mv old-sval old-compst)
          (c::exec-stmt-while old-test old-body compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-stmt-while new-test new-body compst new-fenv limit)))
      (implies (and (> (c::compustate-frames-number compst) 0)
                    (c::compustate-has-vars-with-types-p vartys compst)
                    (while-test-hyp
                     old-test new-test old-fenv new-fenv vartys)
                    (while-body-hyp
                     old-body new-body old-fenv new-fenv types vartys)
                    (not (c::errorp old-sval)))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil types))
                    (c::compustate-has-vars-with-types-p vartys old-compst))))
    :induct (while-induct old-test
                          new-test
                          old-body
                          new-body
                          old-fenv
                          new-fenv
                          compst
                          limit)
    :enable (while-induct
             c::exec-stmt-while
             c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp
             expr-compustate-vars-multi)
    :hints ('(:use ((:instance while-test-hyp-necc
                               (limit (1- limit)))
                    (:instance while-body-hyp-necc
                               (compst
                                (mv-nth 1 (c::exec-expr old-test
                                                        compst
                                                        old-fenv
                                                        (1- limit))))
                               (limit (1- limit)))))))

  (defruled stmt-while-theorem
    (b* ((old (c::stmt-while old-test old-body))
         (new (c::stmt-while new-test new-body))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (and (> (c::compustate-frames-number compst) 0)
                    (c::compustate-has-vars-with-types-p vartys compst)
                    (while-test-hyp
                     old-test new-test old-fenv new-fenv vartys)
                    (while-body-hyp
                     old-body new-body old-fenv new-fenv types vartys)
                    (not (c::errorp old-sval)))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil types)))))
    :expand ((c::exec-stmt
              (c::stmt-while old-test old-body) compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-while new-test new-body) compst new-fenv limit))
    :use (:instance stmt-while-loop-theorem (limit (1- limit))))

  ;; do-while:

  (defund dowhile-induct (old-body
                          new-body
                          old-test
                          new-test
                          old-fenv
                          new-fenv
                          compst
                          limit)
    (declare (xargs :measure (nfix limit)
                    :hints (("Goal" :in-theory (enable nfix o< o-finp)))))
    (b* (((when (zp limit)) nil)
         (compst (c::enter-scope compst))
         ((mv old-sval old-compst)
          (c::exec-stmt old-body compst old-fenv (1- limit)))
         ((when (c::errorp old-sval)) nil)
         ((mv new-sval new-compst)
          (c::exec-stmt new-body compst new-fenv (1- limit)))
         ((when (c::errorp new-sval)) nil)
         ((when (c::stmt-value-case old-sval :return)) nil)
         ((when (c::stmt-value-case new-sval :return)) nil)
         ((unless (equal old-compst new-compst)) nil)
         (compst old-compst)
         (compst (c::exit-scope compst))
         ((mv old-test-eval old-compst)
          (c::exec-expr old-test compst old-fenv (1- limit)))
         ((when (c::errorp old-test-eval)) nil)
         ((unless old-test-eval) nil)
         ((mv new-test-eval new-compst)
          (c::exec-expr new-test compst new-fenv (1- limit)))
         ((when (c::errorp new-test-eval)) nil)
         ((unless new-test-eval) nil)
         ((unless (equal old-compst new-compst)) nil)
         (compst old-compst)
         (old-test-val (c::expr-value->value old-test-eval))
         ((unless (c::type-nonchar-integerp (c::type-of-value old-test-val)))
          nil)
         (new-test-val (c::expr-value->value new-test-eval))
         ((unless (c::type-nonchar-integerp (c::type-of-value new-test-val)))
          nil)
         ((unless (equal old-test-val new-test-val)) nil)
         (old-continuep (c::test-value old-test-val))
         ((when (c::errorp old-continuep)) nil)
         (new-continuep (c::test-value new-test-val))
         ((when (c::errorp new-continuep)) nil)
         ((when (not old-continuep)) nil)
         ((when (not new-continuep)) nil))
      (dowhile-induct old-body
                      new-body
                      old-test
                      new-test
                      old-fenv
                      new-fenv
                      compst
                      (1- limit))))

  (defund-sk dowhile-body-hyp (old-body new-body old-fenv new-fenv types vartys)
    (forall (compst limit)
            (b* (((mv old-body-sval old-body-compst)
                  (c::exec-stmt old-body compst old-fenv limit))
                 ((mv new-body-sval new-body-compst)
                  (c::exec-stmt new-body compst new-fenv limit)))
              (implies (and (> (c::compustate-frames-number compst) 0)
                            (c::compustate-has-vars-with-types-p vartys compst)
                            (not (c::errorp old-body-sval)))
                       (and (not (c::errorp new-body-sval))
                            (equal old-body-sval new-body-sval)
                            (equal old-body-compst new-body-compst)
                            (set::in
                             (c::type-option-of-stmt-value old-body-sval)
                             types)
                            (c::compustate-has-vars-with-types-p
                             vartys old-body-compst))))))

  (defund-sk dowhile-test-hyp (old-test new-test old-fenv new-fenv vartys)
    (forall (compst limit)
            (b* (((mv old-test-eval old-test-compst)
                  (c::exec-expr old-test compst old-fenv limit))
                 ((mv new-test-eval new-test-compst)
                  (c::exec-expr new-test compst new-fenv limit))
                 (old-test-val (c::expr-value->value old-test-eval))
                 (new-test-val (c::expr-value->value new-test-eval)))
              (implies (and (> (c::compustate-frames-number compst) 0)
                            (c::compustate-has-vars-with-types-p vartys compst)
                            (not (c::errorp old-test-eval))
                            old-test-eval)
                       (and (not (c::errorp new-test-eval))
                            new-test-eval
                            (equal old-test-val new-test-val)
                            (equal old-test-compst new-test-compst)
                            (c::type-nonchar-integerp
                             (c::type-of-value old-test-val)))))))

  (defruled stmt-dowhile-loop-theorem
    (b* (((mv old-sval old-compst)
          (c::exec-stmt-dowhile old-body old-test compst old-fenv limit))
         ((mv new-sval new-compst)
          (c::exec-stmt-dowhile new-body new-test compst new-fenv limit)))
      (implies (and (> (c::compustate-frames-number compst) 0)
                    (c::compustate-has-vars-with-types-p vartys compst)
                    (dowhile-body-hyp
                     old-body new-body old-fenv new-fenv types vartys)
                    (dowhile-test-hyp
                     old-test new-test old-fenv new-fenv vartys)
                    (not (c::errorp old-sval)))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil types))
                    (c::compustate-has-vars-with-types-p vartys old-compst))))
    :induct (dowhile-induct old-body
                            new-body
                            old-test
                            new-test
                            old-fenv
                            new-fenv
                            compst
                            limit)
    :enable (dowhile-induct
             c::exec-stmt-dowhile
             c::apconvert-expr-value-when-not-array
             c::value-kind-not-array-when-value-integerp
             c::compustate-has-vars-with-types-p-of-enter-scope
             c::compustate-has-vars-with-types-p-of-exit-exec-enter
             expr-compustate-vars-multi)
    :hints ('(:use ((:instance dowhile-body-hyp-necc
                               (compst (c::enter-scope compst))
                               (limit (1- limit)))
                    (:instance dowhile-test-hyp-necc
                               (compst
                                (c::exit-scope
                                 (mv-nth 1 (c::exec-stmt old-body
                                                         (c::enter-scope compst)
                                                         old-fenv
                                                         (1- limit)))))
                               (limit (1- limit)))))))

  (defruled stmt-dowhile-theorem
    (b* ((old (c::stmt-dowhile old-body old-test))
         (new (c::stmt-dowhile new-body new-test))
         ((mv old-sval old-compst) (c::exec-stmt old compst old-fenv limit))
         ((mv new-sval new-compst) (c::exec-stmt new compst new-fenv limit)))
      (implies (and (> (c::compustate-frames-number compst) 0)
                    (c::compustate-has-vars-with-types-p vartys compst)
                    (dowhile-body-hyp
                     old-body new-body old-fenv new-fenv types vartys)
                    (dowhile-test-hyp
                     old-test new-test old-fenv new-fenv vartys)
                    (not (c::errorp old-sval)))
               (and (not (c::errorp new-sval))
                    (equal old-sval new-sval)
                    (equal old-compst new-compst)
                    (set::in (c::type-option-of-stmt-value old-sval)
                             (set::insert nil types)))))
    :enable c::compustate-has-vars-with-types-p-of-enter-scope
    :expand ((c::exec-stmt
              (c::stmt-dowhile old-body old-test) compst old-fenv limit)
             (c::exec-stmt
              (c::stmt-dowhile new-body new-test) compst new-fenv limit))
    :use (:instance stmt-dowhile-loop-theorem
                    (compst (c::enter-scope compst))
                    (limit (1- limit)))))
