text:
(** * Hoare: Hoare Logic *)
(* ################################################################# *)
(** * Acknowledgement *)

(** The materials are borrowed from the  _Software Foundations_ series.
    http://softwarefoundations.cis.upenn.edu
 *)

(**
    [coqc Coq_Lecture1_Basics Coq_Lecture2_Induction_List Coq_Lecture3_Tactics_Logic Coq_Lecture4_Program Coq_Lecture5_Hoare]
*)

Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.omega.Omega.
Require Export Coq_Lecture4_Program.

Local Open Scope aexp_scope.
Local Open Scope bexp_scope.

(** In the final lecture, we began applying the mathematical tools
    developed in the first part of the course to studying the theory
    of a small programming language, Imp.

    - We defined a type of _abstract syntax trees_ for Imp, together
      with an _evaluation relation_ (a partial function on states)
      that specifies the _operational semantics_ of programs.

      The language we defined, though small, captures some of the key
      features of full-blown languages like C, C++, and Java,
      including the fundamental notion of mutable state and some
      common control structures.

    - We proved a number of _metatheoretic properties_ -- "meta" in
      the sense that they are properties of the language as a whole,
      rather than of particular programs in the language.  These
      included:

        - determinism of evaluation

        - equivalence of some different ways of writing down the
          definitions (e.g., functional and relational definitions of
          arithmetic expression evaluation)

        - guaranteed termination of certain classes of programs

        - correctness (in the sense of preserving meaning) of a number
          of useful program transformations

        - behavioral equivalence of programs (in the [Equiv]
          chapter). *)

(** If we stopped here, we would already have something useful: a set
    of tools for defining and discussing programming languages and
    language features that are mathematically precise, flexible, and
    easy to work with, applied to a set of key properties.  All of
    these properties are things that language designers, compiler
    writers, and users might care about knowing.  Indeed, many of them
    are so fundamental to our understanding of the programming
    languages we deal with that we might not consciously recognize
    them as "theorems."  But properties that seem intuitively obvious
    can sometimes be quite subtle (sometimes also subtly wrong!).

    We'll return to the theme of metatheoretic properties of whole
    languages later in this volume when we discuss _types_ and _type
    soundness_.  In this chapter, though, we turn to a different set
    of issues.

    Our goal is to carry out some simple examples of _program
    verification_ -- i.e., to use the precise definition of Imp to
    prove formally that particular programs satisfy particular
    specifications of their behavior.  We'll develop a reasoning
    system called _Floyd-Hoare Logic_ -- often shortened to just
    _Hoare Logic_ -- in which each of the syntactic constructs of Imp
    is equipped with a generic "proof rule" that can be used to reason
    compositionally about the correctness of programs involving this
    construct.

    Hoare Logic originated in the 1960s, and it continues to be the
    subject of intensive research right up to the present day.  It
    lies at the core of a multitude of tools that are being used in
    academia and industry to specify and verify real software systems.

    Hoare Logic combines two beautiful ideas: a natural way of writing
    down _specifications_ of programs, and a _compositional proof
    technique_ for proving that programs are correct with respect to
    such specifications -- where by "compositional" we mean that the
    structure of proofs directly mirrors the structure of the programs
    that they are about. *)

(** This chapter:
      - A systematic method for reasoning about the _functional
        correctness_ of programs in Imp

    Goals:
      - a natural notation for _program specifications_ and
      - a _compositional_ proof technique for program correctness

    Plan:
      - specifications (assertions / Hoare triples)
      - proof rules
      - loop invariants
      - decorated programs
      - examples *)

(* ################################################################# *)
(** * Assertions *)

(** To talk about specifications of programs, the first thing we
    need is a way of making _assertions_ about properties that hold at
    particular points during a program's execution -- i.e., claims
    about the current state of the memory when execution reaches that
    point.  Formally, an assertion is just a family of propositions
    indexed by a [state]. *)

Definition Assertion := state -> Prop.

(** **** Exercise: 1 star, optional (assertions)  *)
(** Paraphrase the following assertions in English (or your favorite
    natural language). *)

Module ExAssertions.
  Definition as1 : Assertion := fun st => st X = 3.
  Definition as2 : Assertion := fun st => st X <= st Y.
  Definition as3 : Assertion :=
    fun st => st X = 3 \/ st X <= st Y.
  Definition as4 : Assertion :=
    fun st => st Z * st Z <= st X /\
              ~ (((S (st Z)) * (S (st Z))) <= st X).
  Definition as5 : Assertion := fun st => True.
  Definition as6 : Assertion := fun st => False.
  (* FILL IN HERE *)
End ExAssertions.
(** [] *)

(** This way of writing assertions can be a little bit heavy,
    for two reasons: (1) every single assertion that we ever write is
    going to begin with [fun st => ]; and (2) this state [st] is the
    only one that we ever use to look up variables in assertions (we
    will never need to talk about two different memory states at the
    same time).  For discussing examples informally, we'll adopt some
    simplifying conventions: we'll drop the initial [fun st =>], and
    we'll write just [X] to mean [st X].  Thus, instead of writing *)
(**

      fun st => (st Z) * (st Z) <= m /\
                ~ ((S (st Z)) * (S (st Z)) <= m)

    we'll write just

      Z * Z <= m /\ ~((S Z) * (S Z) <= m).
 *)

(** This example also illustrates a convention that we'll use
    throughout the Hoare Logic chapters: in informal assertions,
    capital letters like [X], [Y], and [Z] are Imp variables, while
    lowercase letters like [x], [y], [m], and [n] are ordinary Coq
    variables (of type [nat]).  This is why, when translating from
    informal to formal, we replace [X] with [st X] but leave [m]
    alone. *)

(** Given two assertions [P] and [Q], we say that [P] _implies_ [Q],
    written [P ->> Q], if, whenever [P] holds in some state [st], [Q]
    also holds. *)

Definition assert_implies (P Q : Assertion) : Prop :=
  forall st, P st -> Q st.

Notation "P ->> Q" := (assert_implies P Q)
                        (at level 80) : hoare_spec_scope.
Open Scope hoare_spec_scope.

(** (The [hoare_spec_scope] annotation here tells Coq that this
    notation is not global but is intended to be used in particular
    contexts.  The [Open Scope] tells Coq that this file is one such
    context.) *)

(** We'll also want the "iff" variant of implication between
    assertions: *)

Notation "P <<->> Q" :=
  (P ->> Q /\ Q ->> P) (at level 80) : hoare_spec_scope.

(* ################################################################# *)
(** * Hoare Triples *)

(** Next, we need a way of making formal claims about the
    behavior of commands. *)

(** In general, the behavior of a command is to transform one state to
    another, so it is natural to express claims about commands in
    terms of assertions that are true before and after the command
    executes:

      - "If command [c] is started in a state satisfying assertion
        [P], and if [c] eventually terminates in some final state,
        then this final state will satisfy the assertion [Q]."

    Such a claim is called a _Hoare Triple_.  The assertion [P] is
    called the _precondition_ of [c], while [Q] is the
    _postcondition_.  *)

(** Formally: *)

Definition hoare_triple
           (P:Assertion) (c:com) (Q:Assertion) : Prop :=
  forall st st',
    c / st \\ st' ->
    P st ->
    Q st'.

(** Since we'll be working a lot with Hoare triples, it's useful to
    have a compact notation:

       {{P}} c {{Q}}.
 *)
(** (The traditional notation is [{P} c {Q}], but single braces
    are already used for other things in Coq.)  *)

Notation "{{ P }}  c  {{ Q }}" :=
  (hoare_triple P c Q) (at level 90, c at next level)
  : hoare_spec_scope.

(** **** Exercise: 1 star, optional (triples)  *)
(** Paraphrase the following Hoare triples in English.

   1) {{True}} c {{X = 5}}

   2) {{X = m}} c {{X = m + 5)}}

   3) {{X <= Y}} c {{Y <= X}}

   4) {{True}} c {{False}}

   5) {{X = m}}
      c
      {{Y = real_fact m}}

   6) {{X = m}}
      c
      {{(Z * Z) <= m /\ ~ (((S Z) * (S Z)) <= m)}}
 *)

(** [] *)

(** **** Exercise: 1 star, optional (valid_triples)  *)
(** Which of the following Hoare triples are _valid_ -- i.e., the
    claimed relation between [P], [c], and [Q] is true?

   1) {{True}} X ::= 5 {{X = 5}}

   2) {{X = 2}} X ::= X + 1 {{X = 3}}

   3) {{True}} X ::= 5; Y ::= 0 {{X = 5}}

   4) {{X = 2 /\ X = 3}} X ::= 5 {{X = 0}}

   5) {{True}} SKIP {{False}}

   6) {{False}} SKIP {{True}}

   7) {{True}} WHILE true DO SKIP END {{False}}

   8) {{X = 0}}
        WHILE X = 0 DO X ::= X + 1 END
      {{X = 1}}

   9) {{X = 1}}
        WHILE !(X = 0) DO X ::= X + 1 END
      {{X = 100}}
 *)
(** [] *)

(** To get us warmed up for what's coming, here are two simple facts
    about Hoare triples.  (Make sure you understand what they mean.) *)

Theorem hoare_post_true : forall (P Q : Assertion) c,
    (forall st, Q st) ->
    {{P}} c {{Q}}.
Proof.
  intros P Q c H. unfold hoare_triple.
  intros st st' Heval HP.
  apply H.  Qed.

Theorem hoare_pre_false : forall (P Q : Assertion) c,
    (forall st, ~(P st)) ->
    {{P}} c {{Q}}.
Proof.
  intros P Q c H. unfold hoare_triple.
  intros st st' Heval HP.
  unfold not in H. apply H in HP.
  inversion HP.  Qed.

(* ################################################################# *)
(** * Proof Rules *)

(** The goal of Hoare logic is to provide a _compositional_
    method for proving the validity of specific Hoare triples.  That
    is, we want the structure of a program's correctness proof to
    mirror the structure of the program itself.  To this end, in the
    sections below, we'll introduce a rule for reasoning about each of
    the different syntactic forms of commands in Imp -- one for
    assignment, one for sequencing, one for conditionals, etc. -- plus
    a couple of "structural" rules for gluing things together.  We
    will then be able to prove programs correct using these proof
    rules, without ever unfolding the definition of [hoare_triple]. *)

(* ================================================================= *)
(** ** Assignment *)

(** The rule for assignment is the most fundamental of the Hoare logic
    proof rules.  Here's how it works.

    Consider this valid Hoare triple:

       {{ Y = 1 }}  X ::= Y  {{ X = 1 }}

    In English: if we start out in a state where the value of [Y]
    is [1] and we assign [Y] to [X], then we'll finish in a
    state where [X] is [1].
    That is, the property of being equal to [1] gets transferred
    from [Y] to [X]. *)

(** Similarly, in

       {{ Y + Z = 1 }}  X ::= Y + Z  {{ X = 1 }}

    the same property (being equal to one) gets transferred to
    [X] from the expression [Y + Z] on the right-hand side of
    the assignment. *)

(** More generally, if [a] is _any_ arithmetic expression, then

       {{ a = 1 }}  X ::= a {{ X = 1 }}

    is a valid Hoare triple. *)

(** Even more generally, to conclude that an arbitrary assertion [Q]
    holds after [X ::= a], we need to assume that [Q] holds before [X
    ::= a], but _with all occurrences of_ [X] replaced by [a] in
    [Q]. This leads to the Hoare rule for assignment

      {{ Q [a / X] }} X ::= a {{ Q }}

    where "[Q [a / X]]" is pronounced "[Q] where [a] is substituted
    for [X]". *)

(** For example, these are valid applications of the assignment
    rule:

      {{ (X <= 5) [X + 1 / X]
         i.e., X + 1 <= 5 }}
      X ::= X + 1
      {{ X <= 5 }}

      {{ (X = 3) [3 / X]
         i.e., 3 = 3}}
      X ::= 3
      {{ X = 3 }}

      {{ (0 <= X /\ X <= 5) [3 / X]
         i.e., (0 <= 3 /\ 3 <= 5)}}
      X ::= 3
      {{ 0 <= X /\ X <= 5 }}
 *)

(** To formalize the rule, we must first formalize the idea of
    "substituting an expression for an Imp variable in an assertion",
    which we refer to as assertion substitution, or [assn_sub].  That
    is, given a proposition [P], a variable [X], and an arithmetic
    expression [a], we want to derive another proposition [P'] that is
    just the same as [P] except that [P'] should mention [a] wherever
    [P] mentions [X]. *)

(** Since [P] is an arbitrary Coq assertion, we can't directly "edit"
    its text.  However, we can achieve the same effect by evaluating
    [P] in an updated state: *)

Definition assn_sub X e P : Assertion :=
  fun (st : state) =>
    P (st & { X  --> aeval st e }).

Notation "P [ e // X ]" := (assn_sub X e P) (at level 10).

(** That is, [P [ e / X]] stands for an assertion -- let's call it [P'] --
    that is just like [P] except that, wherever [P] looks up the
    variable [X] in the current state, [P'] instead uses the value
    of the expression [e]. *)

(** To see how this works, let's calculate what happens with a couple
    of examples.  First, suppose [P'] is [(X <= 5) [ 3 / X]] -- that
    is, more formally, [P'] is the Coq expression

    fun st =>
      (fun st' => st' X <= 5)
      (st & { X --> aeval st 3 }),

    which simplifies to

    fun st =>
      (fun st' => st' X <= 5)
      (st & { X --> 3 })

    and further simplifies to

    fun st =>
      ((st & { X --> 3 }) X) <= 5

    and finally to

    fun st =>
      3 <= 5.

    That is, [P'] is the assertion that [3] is less than or equal to
    [5] (as expected). *)

(** For a more interesting example, suppose [P'] is [(X <= 5) [X + 1 / X]].
    Formally, [P'] is the Coq expression

    fun st =>
      (fun st' => st' X <= 5)
      (st & { X --> aeval st (X+1) }),

    which simplifies to

    fun st =>
      (st & { X --> aeval st (X+1) }) X <= 5

    and further simplifies to

    fun st =>
      (aeval st (X+1)) <= 5.

    That is, [P'] is the assertion that [X+1] is at most [5].
 *)

(** Now, using the concept of substitution, we can give the precise
    proof rule for assignment:

      ------------------------------ (hoare_asgn)
      {{Q [e // X]}} X ::= e {{Q}}
 *)

(** We can prove formally that this rule is indeed valid. *)

Theorem hoare_asgn : forall Q X e,
    {{Q [ e // X]}} (X ::= e) {{Q}}.
Proof.
  unfold hoare_triple.
  intros.
  inversion H.
  subst.
  assumption.
Qed.

(** Here's a first formal proof using this rule. *)
Example assn_sub_example :
  {{(fun st => st X < 5) [X.+1 // X]}}
    (X ::= X.+1)
  {{fun st => st X < 5}}.
Proof.
  apply hoare_asgn.
Qed.

(** Of course, what would be even more helpful is to prove this
    simpler triple:

      {{X < 4}} (X ::= X+1) {{X < 5}}

   We will see how to do so in the next section. *)

(** **** Exercise: 2 stars, recommended (hoare_asgn_wrong)  *)
(** The assignment rule looks backward to almost everyone the first
    time they see it.  If it still seems puzzling, it may help
    to think a little about alternative "forward" rules.  Here is a
    seemingly natural one:

      ------------------------------ (hoare_asgn_wrong)
      {{ True }} X ::= a {{ X = a }}

    Give a counterexample showing that this rule is incorrect and
    argue informally that it is really a counterexample.  (Hint:
    The rule universally quantifies over the arithmetic expression
    [a], and your counterexample needs to exhibit an [a] for which
    the rule doesn't work.) *)

(* FILL IN HERE *)

(* ================================================================= *)
(** ** Consequence *)

(** Sometimes the preconditions and postconditions we get from the
    Hoare rules won't quite be the ones we want in the particular
    situation at hand -- they may be logically equivalent but have a
    different syntactic form that fails to unify with the goal we are
    trying to prove, or they actually may be logically weaker (for
    preconditions) or stronger (for postconditions) than what we need.

    For instance, while

      {{(X = 3) [3 / X]}} X ::= 3 {{X = 3}},

    follows directly from the assignment rule,

      {{True}} X ::= 3 {{X = 3}}

    does not.  This triple is valid, but it is not an instance of
    [hoare_asgn] because [True] and [(X = 3) [3 / X]] are not
    syntactically equal assertions.  However, they are logically
    _equivalent_, so if one triple is valid, then the other must
    certainly be as well.  We can capture this observation with the
    following rule:

                {{P'}} c {{Q}}
                  P <<->> P'
         -----------------------------   (hoare_consequence_pre_equiv)
                {{P}} c {{Q}}
 *)

(** Taking this line of thought a bit further, we can see that
    strengthening the precondition or weakening the postcondition of a
    valid triple always produces another valid triple. This
    observation is captured by two _Rules of Consequence_.

                {{P'}} c {{Q}}
                   P ->> P'
         -----------------------------   (hoare_consequence_pre)
                {{P}} c {{Q}}

                {{P}} c {{Q'}}
                  Q' ->> Q
         -----------------------------    (hoare_consequence_post)
                {{P}} c {{Q}}
 *)

(** Here are the formal versions: *)

Theorem hoare_weak_pre : forall (P P' Q : Assertion) c,
    {{P'}} c {{Q}} ->
    P ->> P' ->
    {{P}} c {{Q}}.
Proof.
  intros P P' Q c Hhoare Himp.
  intros st st' Hc HP. apply (Hhoare st st').
  assumption. apply Himp. assumption. Qed.

Theorem hoare_weak_post : forall (P Q Q' : Assertion) c,
    {{P}} c {{Q'}} ->
    Q' ->> Q ->
    {{P}} c {{Q}}.
Proof.
  intros P Q Q' c Hhoare Himp.
  intros st st' Hc HP.
  apply Himp.
  apply (Hhoare st st').
  assumption. assumption. Qed.

(** For example, we can use the first consequence rule like this:

    {{ True }} ->>
    {{ 1 = 1 }}
    X ::= 1
    {{ X = 1 }}

    Or, formally... *)

Example hoare_asgn_example1 :
  {{fun st => True}} (X ::= 1) {{fun st => st X = 1}}.
Proof.
  eapply hoare_weak_pre.
  - apply hoare_asgn.
  - intros st HP.
    reflexivity.
Qed.

(** We can also use it to prove the example mentioned earlier.

		{{ X < 4 }} ->>
		{{ (X < 5)[X+1 // X] }}
    X ::= X + 1
	        {{ X < 5 }}

   Or, formally ... *)

Example assn_sub_example2 :
  {{(fun st => st X < 4)}}
    (X ::= X.+1)
    {{fun st => st X < 5}}.
Proof.
  eapply hoare_weak_pre.
  - apply hoare_asgn.
  - intros st HP.
    unfold assn_sub.
    unfold t_update.
    simpl.
    omega.
Qed.

(** Finally, for convenience in proofs, here is a combined rule of
    consequence that allows us to vary both the precondition and the
    postcondition in one go.

                {{P'}} c {{Q'}}
                   P ->> P'
                   Q' ->> Q
         -----------------------------   (hoare_consequence)
                {{P}} c {{Q}}
 *)

Theorem hoare_weak : forall (P P' Q Q' : Assertion) c,
    {{P'}} c {{Q'}} ->
    P ->> P' ->
    Q' ->> Q ->
    {{P}} c {{Q}}.
Proof.
  intros P P' Q Q' c Hht HPP' HQ'Q.
  apply hoare_weak_pre with (P' := P').
  apply hoare_weak_post with (Q' := Q').
  assumption. assumption. assumption.  Qed.

(* ================================================================= *)
(** ** Skip *)

(** Since [SKIP] doesn't change the state, it preserves any
    assertion [P]:

      --------------------  (hoare_skip)
      {{ P }} SKIP {{ P }}
 *)

Theorem hoare_skip : forall P,
    {{P}} SKIP {{P}}.
Proof.
  intros P st st' H HP. inversion H. subst.
  assumption.  Qed.

(* ================================================================= *)
(** ** Sequencing *)

(** More interestingly, if the command [c1] takes any state where
    [P] holds to a state where [Q] holds, and if [c2] takes any
    state where [Q] holds to one where [R] holds, then doing [c1]
    followed by [c2] will take any state where [P] holds to one
    where [R] holds:

        {{ P }} c1 {{ Q }}
        {{ Q }} c2 {{ R }}
       ---------------------  (hoare_seq)
       {{ P }} c1;;c2 {{ R }}
 *)

Theorem hoare_seq : forall P Q R c1 c2,
    {{Q}} c2 {{R}} ->
    {{P}} c1 {{Q}} ->
    {{P}} c1;;c2 {{R}}.
Proof.
  intros P Q R c1 c2 H1 H2 st st' H12 Pre.
  inversion H12; subst.
  apply (H1 st'0 st'); try assumption.
  apply (H2 st st'0); assumption. Qed.

(** Note that, in the formal rule [hoare_seq], the premises are
    given in backwards order ([c2] before [c1]).  This matches the
    natural flow of information in many of the situations where we'll
    use the rule, since the natural way to construct a Hoare-logic
    proof is to begin at the end of the program (with the final
    postcondition) and push postconditions backwards through commands
    until we reach the beginning. *)

(** Informally, a nice way of displaying a proof using the sequencing
    rule is as a "decorated program" where the intermediate assertion
    [Q] is written between [c1] and [c2]:

      {{ a = n }}
    X ::= a;;
      {{ X = n }}    <---- decoration for Q
    SKIP
      {{ X = n }}
 *)

(** Here's an example of a program involving both assignment and
    sequencing. *)

Example hoare_asgn_example3 : forall a n,
    {{fun st => aeval st a = n}}
      (X ::= a;; SKIP)
    {{fun st => st X = n}}.
Proof.
  intros.
  eapply hoare_seq.
  - apply hoare_skip.
  - eapply hoare_weak_pre.
    + apply hoare_asgn.
    + intros st HP.
      assumption.
Qed.

(** We typically use [hoare_seq] in conjunction with
    [hoare_consequence_pre] and the [eapply] tactic, as in this
    example. *)

(** **** Exercise: 2 stars, recommended (hoare_asgn_example4)  *)
(** Translate this "decorated program" into a formal proof:

                   {{ True }} ->>
                   {{ 1 = 1 }}
    X ::= 1;;
                   {{ X = 1 }} ->>
                   {{ X = 1 /\ 2 = 2 }}
    Y ::= 2
                   {{ X = 1 /\ Y = 2 }}

   (Note the use of "[->>]" decorations, each marking a use of
   [hoare_consequence_pre].) *)

Example hoare_asgn_example4 :
  {{fun st => True}}
    (X ::= 1;; Y ::= 2)
    {{fun st => st X = 1 /\ st Y = 2}}.
Proof.
  eapply hoare_seq.
  - apply hoare_asgn.
  - eapply hoare_weak_pre.
    + apply hoare_asgn.
    + intros st HP.
      split; reflexivity.
Qed.

(* ================================================================= *)
(** ** Conditionals *)

(** What sort of rule do we want for reasoning about conditional
    commands?

    Certainly, if the same assertion [Q] holds after executing
    either of the branches, then it holds after the whole conditional.
    So we might be tempted to write:

              {{P}} c1 {{Q}}
              {{P}} c2 {{Q}}
      --------------------------------
      {{P}} IFB b THEN c1 ELSE c2 {{Q}}
 *)

(** However, this is rather weak. For example, using this rule,
   we cannot show

     {{ True }}
     IFB X = 0
     THEN Y ::= 2
     ELSE Y ::= X + 1
     FI
     {{ X <= Y }}

   since the rule tells us nothing about the state in which the
   assignments take place in the "then" and "else" branches. *)

(** Fortunately, we can say something more precise.  In the
    "then" branch, we know that the boolean expression [b] evaluates to
    [true], and in the "else" branch, we know it evaluates to [false].
    Making this information available in the premises of the rule gives
    us more information to work with when reasoning about the behavior
    of [c1] and [c2] (i.e., the reasons why they establish the
    postcondition [Q]). *)
(**

              {{P /\  b}} c1 {{Q}}
              {{P /\ ~b}} c2 {{Q}}
      ------------------------------------  (hoare_if)
      {{P}} IFB b THEN c1 ELSE c2 FI {{Q}}
 *)

(** To interpret this rule formally, we need to do a little work.
    Strictly speaking, the assertion we've written, [P /\ b], is the
    conjunction of an assertion and a boolean expression -- i.e., it
    doesn't typecheck.  To fix this, we need a way of formally
    "lifting" any bexp [b] to an assertion.  We'll write [bassn b] for
    the assertion "the boolean expression [b] evaluates to [true] (in
    the given state)." *)

Definition bassn b : Assertion :=
  fun st => (beval st b = true).

(** A couple of useful facts about [bassn]: *)

Lemma bexp_eval_true : forall b st,
    beval st b = true -> (bassn b) st.
Proof.
  intros b st Hbe.
  unfold bassn. assumption.  Qed.

Lemma bexp_eval_false : forall b st,
    beval st b = false -> ~ ((bassn b) st).
Proof.
  intros b st Hbe contra.
  unfold bassn in contra.
  rewrite -> contra in Hbe. inversion Hbe.  Qed.

(** Now we can formalize the Hoare proof rule for conditionals
    and prove it correct. *)

Theorem hoare_if : forall P Q b c1 c2,
    {{fun st => P st /\ bassn b st}} c1 {{Q}} ->
    {{fun st => P st /\ ~(bassn b st)}} c2 {{Q}} ->
    {{P}} (IFB b THEN c1 ELSE c2 FI) {{Q}}.
Proof.
  intros P Q b c1 c2 HTrue HFalse st st' HE HP.
  inversion HE; subst.
  - (* b is true *)
    apply (HTrue st st').
    assumption.
    split. assumption.
    apply bexp_eval_true. assumption.
  - (* b is false *)
    apply (HFalse st st').
    assumption.
    split. assumption.
    apply bexp_eval_false. assumption. Qed.

(* ----------------------------------------------------------------- *)
(** *** Example *)

(** Here is a formal proof that the program we used to motivate the
    rule satisfies the specification we gave.
Hint: beq_nat_true, omega
*)

Example if_example :
  {{fun st => True}}
    IFB X =? 0
    THEN Y ::= 2
    ELSE Y ::= X .+ 1
    FI
    {{fun st => st X <= st Y}}.
Proof.
  apply hoare_if.
  - (* Then *)
    eapply hoare_weak_pre. apply hoare_asgn.
    unfold bassn, assn_sub, t_update, assert_implies.
    simpl. intros st [_ H].
    apply beq_nat_true in H.
    rewrite H. omega.
  - (* Else *)
    eapply hoare_weak_pre. apply hoare_asgn.
    unfold assn_sub, t_update, assert_implies.
    simpl; intros st _. omega.
Qed.

(* ================================================================= *)
(** ** Loops *)

(** Finally, we need a rule for reasoning about while loops. *)

(** Suppose we have a loop

      WHILE b DO c END

    and we want to find a pre-condition [P] and a post-condition
    [Q] such that

      {{P}} WHILE b DO c END {{Q}}

    is a valid triple. *)

(** First of all, let's think about the case where [b] is false at the
    beginning -- i.e., let's assume that the loop body never executes
    at all.  In this case, the loop behaves like [SKIP], so we might
    be tempted to write: *)

(**

      {{P}} WHILE b DO c END {{P}}.
 *)

(** But, as we remarked above for the conditional, we know a
    little more at the end -- not just [P], but also the fact
    that [b] is false in the current state.  So we can enrich the
    postcondition a little: *)
(**

      {{P}} WHILE b DO c END {{P /\ ~b}}
 *)

(** What about the case where the loop body _does_ get executed?
    In order to ensure that [P] holds when the loop finally
    exits, we certainly need to make sure that the command [c]
    guarantees that [P] holds whenever [c] is finished.
    Moreover, since [P] holds at the beginning of the first
    execution of [c], and since each execution of [c]
    re-establishes [P] when it finishes, we can always assume
    that [P] holds at the beginning of [c].  This leads us to the
    following rule: *)
(**

                   {{P}} c {{P}}
        -----------------------------------
        {{P}} WHILE b DO c END {{P /\ ~b}}
 *)
(** This is almost the rule we want, but again it can be improved a
    little: at the beginning of the loop body, we know not only that
    [P] holds, but also that the guard [b] is true in the current
    state. *)

(** This gives us a little more information to use in
    reasoning about [c] (showing that it establishes the invariant by
    the time it finishes).  *)
(** This gives us the final version of the rule: *)
(**

               {{P /\ b}} c {{P}}
        -----------------------------------  (hoare_while)
        {{P}} WHILE b DO c END {{P /\ ~b}}

    The proposition [P] is called an _invariant_ of the loop.
 *)

Theorem hoare_while : forall P b c,
    {{fun st => P st /\ bassn b st}} c {{P}} ->
    {{P}} WHILE b DO c END {{fun st => P st /\ ~ (bassn b st)}}.
Proof.
  intros P b c Hhoare st st' He HP.
  (* Like we've seen before, we need to reason by induction
     on [He], because, in the "keep looping" case, its hypotheses
     talk about the whole loop instead of just [c]. *)
  remember (WHILE b DO c END) as wcom eqn:Heqwcom.
  induction He;
    try (inversion Heqwcom); subst; clear Heqwcom.
  - (* E_WhileFalse *)
    split. assumption. apply bexp_eval_false. assumption.
  - (* E_WhileTrue *)
    apply IHHe2. reflexivity.
    apply (Hhoare st st'). assumption.
    split. assumption. apply bexp_eval_true. assumption.
Qed.

(** One subtlety in the terminology is that calling some assertion [P]
    a "loop invariant" doesn't just mean that it is preserved by the
    body of the loop in question (i.e., [{{P}} c {{P}}], where [c] is
    the loop body), but rather that [P] _together with the fact that
    the loop's guard is true_ is a sufficient precondition for [c] to
    ensure [P] as a postcondition.

    This is a slightly (but importantly) weaker requirement.  For
    example, if [P] is the assertion [X = 0], then [P] _is_ an
    invariant of the loop

    WHILE X = 2 DO X := 1 END

    although it is clearly _not_ preserved by the body of the
    loop.

    Hint: leb, leb_complete, leb_iff_conv
*)

(** Hint:
    bassn, assert_implies, assn_sub, t_update, beval, aeval
    not_true_iff_false
    not_false_iff_true
    negb_true_iff
    negb_false_iff
    beq_nat_true_iff
    beq_nat_false_iff
    leb_iff
    leb_iff_conv
 *)

Ltac simplb :=
  repeat match goal with
         | [H0: leb _ _ = true |- _ ] =>
           rewrite leb_iff in H0
         | [H0: leb _ _ = false |- _ ] =>
           rewrite leb_iff_conv in H0
         | [H0: _ <> true |- _ ] =>
           rewrite not_true_iff_false in H0
         | [H0: _ <> false |- _ ] =>
           rewrite not_false_iff_true in H0
         | [H0: beq_nat _ _ = true |- _ ] =>
           rewrite beq_nat_true_iff in H0
         | [H0: beq_nat _ _ = false |- _ ] =>
           rewrite beq_nat_false_iff in H0
         | [H0: negb _ = true |- _] =>
           rewrite negb_true_iff in H0
         | [H0: negb _ = false |- _] =>
           rewrite negb_false_iff in H0
         end.

Ltac my_simpl :=
  unfold assert_implies, assn_sub, bassn, beval, aeval, t_update in *;
  simpl in *; intros;
  repeat match goal with
         | [ H0: _ /\ _ |- _ ] => destruct H0
         end;
  simplb; eauto; try omega; try congruence.

Ltac hoare :=
  intros;
  repeat match goal with
         | [|- {{ _ }} ?C {{ _ }}] =>
           match C with
           | WHILE _ DO _ END =>
             eapply hoare_weak_post; [eapply hoare_while | my_simpl]
           | _ ::= _ =>
                   try (apply hoare_asgn);
                   match goal with
                   | [|- {{_}} _ ::= _ {{ _ }}] =>
                        eapply hoare_weak_pre; [eapply hoare_asgn | my_simpl]
                   end
           | IFB _ THEN _ ELSE _ FI => eapply hoare_if
           | SKIP => eapply hoare_weak_pre; [eapply hoare_skip| my_simpl]
           | _ ;; _ => eapply hoare_seq
           end
         end.

Example while_example :
  {{fun st => st X <= 3}}
    WHILE X <=? 2
    DO X ::= X .+ 1 END
  {{fun st => st X >= 3}}.
Proof.
  hoare.
Qed.

Example while_example1 :
  {{fun st => st X = 5}}
    WHILE X <=? 2
    DO X ::= X .+ 1 END
  {{fun st => st X >= 3}}.
Proof.
  hoare.
Qed.

Example if_example1:
  {{fun st => True}}
    IFB X =? 0
    THEN Y ::= 2
    ELSE Y ::= X .+ 1
    FI
  {{fun st => st X <= st Y}}.
Proof.
  hoare.
Qed.

Example if_minus_plus_dec1:
  {{fun st => True}}
  IFB X <=? Y  THEN
    Z ::= Y .- X
  ELSE
    Y ::= X .+ Z
  FI
  {{fun st => st Y = st X + st Z}}.
Proof.
  hoare.
Qed.

Theorem always_loop_hoare : forall P Q,
    {{P}} WHILE true DO SKIP END {{Q}}.
Proof.
  hoare.
Qed.

Example swap_dec1:
  forall m n,
  {{ fun st => st X = m /\ st Y = n}}
  X ::= X .+ Y ;;
  Y ::= X .- Y ;;
  X ::= X .- Y
  {{ fun st => st X = n /\ st Y = m}}.
Proof.
  hoare.
Qed.

Local Opaque minus.

Example if_example2:
  {{fun st => True}}
    IFB X <=? 5
    THEN Y ::= 11 .- X
    ELSE Y ::= X
    FI
  {{fun st => st Y > 5}}.
Proof.
  hoare.
Qed.

(*
// { x0 = x+z }             (PRE)
while z != 0 {
  // { x0 = x+z ∧ z != 0}   (WHILE)
  // { x0 = (x+1)+(z-1) }   (WEAK)
  x := x + 1;
  // { x0 = x+(z-1) }       (ASG)
  z := z - 1;
  // { x0 = x+z }           (ASG)
}
// { x0 = x+z ∧ z = 0 }     (WHILE)
 *)

Example while_example2:
  forall x0,
  {{fun st => x0 = st X + st Y}}
    WHILE ! (Y =? 0)
    DO X ::= X .+ 1 ;; Y ::= Y .- 1
    END
  {{fun st => x0 = st X + st Y /\ st Y = 0}}.
Proof.
  hoare.
Qed.

(*
// Proof.
// { x > 0 }                (PRE)
// { 1 = 0! }               (WEAK)
y := 1;
// { y = 0! }               (ASG)
z := 0;
// { y = z! }               (ASG)
while (z != x) {
  // { y = z! ∧ z != x}     (WHILE)
  // { y * (z+1) = (z+1)!}  (WEAK)
  z := z + 1;
  // { y * z = z! }         (ASG)
  y := y * z;
  // { y = z! }             (ASG)
}
// { y = z! ∧ ~(z != x)}    (WHILE)
// { y = x!}
 *)

Print fact.

Example fact_example:
  {{fun st => st X > 0}}
    Y ::= 1 ;;
    Z ::= 0 ;;
    WHILE ! (Z =? X)
    DO Z ::= Z .+ 1 ;; Y ::= Y .* Z
    END
  {{fun st => st Y = fact (st X)}}.
Proof.
  hoare.
  - instantiate (1:= fun st => st Y = fact (st Z)).
    my_simpl.
    replace (st Z + 1)%nat with (S (st Z)) by omega.
    rewrite mult_comm.
    simpl. rewrite <- H. trivial.
  - my_simpl.
  - my_simpl.
Qed.

(** Of course, this result is not surprising if we remember that
    the definition of [hoare_triple] asserts that the postcondition
    must hold _only_ when the command terminates.  If the command
    doesn't terminate, we can prove anything we like about the
    post-condition. *)

(** Hoare rules that only talk about what happens when commands
    terminate (without proving that they do) are often said to
    describe a logic of "partial" correctness.  It is also possible to
    give Hoare rules for "total" correctness, which build in the fact
    that the commands terminate. However, in this course we will only
    talk about partial correctness. *)

(* ################################################################# *)
(** * Summary *)

(** So far, we've introduced Hoare Logic as a tool for reasoning about
    Imp programs. The rules of Hoare Logic are:

             ------------------------------ (hoare_asgn)
             {{Q [X |-> a]}} X::=a {{Q}}

             --------------------  (hoare_skip)
             {{ P }} SKIP {{ P }}

               {{ P }} c1 {{ Q }}
               {{ Q }} c2 {{ R }}
              ---------------------  (hoare_seq)
              {{ P }} c1;;c2 {{ R }}

              {{P /\  b}} c1 {{Q}}
              {{P /\ ~b}} c2 {{Q}}
      ------------------------------------  (hoare_if)
      {{P}} IFB b THEN c1 ELSE c2 FI {{Q}}

               {{P /\ b}} c {{P}}
        -----------------------------------  (hoare_while)
        {{P}} WHILE b DO c END {{P /\ ~b}}

                {{P'}} c {{Q'}}
                   P ->> P'
                   Q' ->> Q
         -----------------------------   (hoare_consequence)
                {{P}} c {{Q}}

    In the next chapter, we'll see how these rules are used to prove
    that programs satisfy specifications of their behavior. *)

(* ################################################################# *)
(** * Decorated Programs *)

(** The beauty of Hoare Logic is that it is _compositional_: the
    structure of proofs exactly follows the structure of programs.

    This suggests that we can record the essential ideas of a
    proof (informally, and leaving out some low-level calculational
    details) by "decorating" a program with appropriate assertions on
    each of its commands.

    Such a _decorated program_ carries within it an argument for its
    own correctness. *)

(** For example, consider the program: *)
(**

    X ::= m;;
    Z ::= p;
    WHILE !(X = 0) DO
      Z ::= Z - 1;;
      X ::= X - 1
    END

   (Note the _parameters_ [m] and [p], which stand for
   fixed-but-arbitrary numbers.  Formally, they are simply Coq
   variables of type [nat].)
*)
(** Here is one possible specification for this program: *)
(**

      {{ True }}
    X ::= m;;
    Z ::= p;
    WHILE !(X = 0) DO
      Z ::= Z - 1;;
      X ::= X - 1
    END
      {{ Z = p - m }}
*)
(** Here is a decorated version of the program, embodying a
    proof of this specification: *)
(**

      {{ True }} ->>
      {{ m = m }}
    X ::= m;;
      {{ X = m }} ->>
      {{ X = m /\ p = p }}
    Z ::= p;
      {{ X = m /\ Z = p }} ->>
      {{ Z - X = p - m }}
    WHILE !(X = 0) DO
        {{ Z - X = p - m /\ X <> 0 }} ->>
        {{ (Z - 1) - (X - 1) = p - m }}
      Z ::= Z - 1;;
        {{ Z - (X - 1) = p - m }}
      X ::= X - 1
        {{ Z - X = p - m }}
    END
      {{ Z - X = p - m /\ ~ (X <> 0) }} ->> {{ Z = p - m }}
*)

(** Concretely, a decorated program consists of the program text
    interleaved with assertions (either a single assertion or possibly
    two assertions separated by an implication). *)

(** To check that a decorated program represents a valid proof, we
    check that each individual command is _locally consistent_ with
    its nearby assertions in the following sense: *)

(** - [SKIP] is locally consistent if its precondition and
      postcondition are the same:

          {{ P }} SKIP {{ P }}
*)

(** - The sequential composition of [c1] and [c2] is locally
      consistent (with respect to assertions [P] and [R]) if [c1] is
      locally consistent (with respect to [P] and [Q]) and [c2] is
      locally consistent (with respect to [Q] and [R]):

          {{ P }} c1;; {{ Q }} c2 {{ R }}
*)

(** - An assignment is locally consistent if its precondition is the
      appropriate substitution of its postcondition:

          {{ P [a // X] }}
          X ::= a
          {{ P }}
*)

(** - A conditional is locally consistent (with respect to assertions
      [P] and [Q]) if the assertions at the top of its "then" and
      "else" branches are exactly [P /\ b] and [P /\ ~b] and if its
      "then" branch is locally consistent (with respect to [P /\ b]
      and [Q]) and its "else" branch is locally consistent (with
      respect to [P /\ ~b] and [Q]):

          {{ P }}
          IFB b THEN
            {{ P /\ b }}
            c1
            {{ Q }}
          ELSE
            {{ P /\ ~b }}
            c2
            {{ Q }}
          FI
          {{ Q }}
*)

(** - A while loop with precondition [P] is locally consistent if its
      postcondition is [P /\ ~b], if the pre- and postconditions of
      its body are exactly [P /\ b] and [P], and if its body is
      locally consistent:

          {{ P }}
          WHILE b DO
            {{ P /\ b }}
            c1
            {{ P }}
          END
          {{ P /\ ~b }}
*)

(** - A pair of assertions separated by [->>] is locally consistent if
      the first implies the second:

          {{ P }} ->>
          {{ P' }}

      This corresponds to the application of [hoare_consequence], and it
      is the _only_ place in a decorated program where checking whether
      decorations are correct is not fully mechanical and syntactic,
      but rather may involve logical and/or arithmetic reasoning. *)

(** These local consistency conditions essentially describe a
    procedure for _verifying_ the correctness of a given proof.
    This verification involves checking that every single command is
    locally consistent with the accompanying assertions.

    If we are instead interested in _finding_ a proof for a given
    specification, we need to discover the right assertions.  This can
    be done in an almost mechanical way, with the exception of finding
    loop invariants, which is the subject of the next section.  In the
    remainder of this section we explain in detail how to construct
    decorations for several simple programs that don't involve
    non-trivial loop invariants. *)

(* ================================================================= *)
(** ** Example: Swapping Using Addition and Subtraction *)

(** Here is a program that swaps the values of two variables using
    addition and subtraction (instead of by assigning to a temporary
    variable).

       X ::= X + Y;;
       Y ::= X - Y;;
       X ::= X - Y

    We can prove using decorations that this program is correct --
    i.e., it always swaps the values of variables [X] and [Y].
*)
(**

    (1)     {{ X = m /\ Y = n }} ->>
    (2)     {{ (X + Y) - ((X + Y) - Y) = n /\ (X + Y) - Y = m }}
           X ::= X + Y;;
    (3)     {{ X - (X - Y) = n /\ X - Y = m }}
           Y ::= X - Y;;
    (4)     {{ X - Y = n /\ Y = m }}
           X ::= X - Y
    (5)     {{ X = n /\ Y = m }}

    These decorations can be constructed as follows:
      - We begin with the undecorated program (the unnumbered lines).
      - We add the specification -- i.e., the outer precondition (1)
        and postcondition (5). In the precondition, we use parameters
        [m] and [n] to remember the initial values of variables [X]
        and [Y] so that we can refer to them in the postcondition (5).
      - We work backwards, mechanically, starting from (5) and
        proceeding until we get to (2). At each step, we obtain the
        precondition of the assignment from its postcondition by
        substituting the assigned variable with the right-hand-side of
        the assignment. For instance, we obtain (4) by substituting
        [X] with [X - Y] in (5), and we obtain (3) by substituting [Y]
        with [X - Y] in (4).
      - Finally, we verify that (1) logically implies (2) -- i.e.,
        that the step from (1) to (2) is a valid use of the law of
        consequence. For this we substitute [X] by [m] and [Y] by [n]
        and calculate as follows:

            (m + n) - ((m + n) - n) = n /\ (m + n) - n = m
            (m + n) - m = n /\ m = m
            n = n /\ m = m

    Note that, since we are working with natural numbers rather than
    fixed-width machine integers, we don't need to worry about the
    possibility of arithmetic overflow anywhere in this argument.
    This makes life quite a bit simpler! *)

(* ================================================================= *)
(** ** Example: Simple Conditionals *)

(** Here is a simple decorated program using conditionals:

      (1)     {{True}}
            IFB X <= Y THEN
      (2)       {{True /\ X <= Y}} ->>
      (3)       {{(Y - X) + X = Y \/ (Y - X) + Y = X}}
              Z ::= Y - X
      (4)       {{Z + X = Y \/ Z + Y = X}}
            ELSE
      (5)       {{True /\ ~(X <= Y) }} ->>
      (6)       {{(X - Y) + X = Y \/ (X - Y) + Y = X}}
              Z ::= X - Y
      (7)       {{Z + X = Y \/ Z + Y = X}}
            FI
      (8)     {{Z + X = Y \/ Z + Y = X}}

These decorations were constructed as follows:
  - We start with the outer precondition (1) and postcondition (8).
  - We follow the format dictated by the [hoare_if] rule and copy the
    postcondition (8) to (4) and (7). We conjoin the precondition (1)
    with the guard of the conditional to obtain (2). We conjoin (1)
    with the negated guard of the conditional to obtain (5).
  - In order to use the assignment rule and obtain (3), we substitute
    [Z] by [Y - X] in (4). To obtain (6) we substitute [Z] by [X - Y]
    in (7).
  - Finally, we verify that (2) implies (3) and (5) implies (6). Both
    of these implications crucially depend on the ordering of [X] and
    [Y] obtained from the guard. For instance, knowing that [X <= Y]
    ensures that subtracting [X] from [Y] and then adding back [X]
    produces [Y], as required by the first disjunct of (3). Similarly,
    knowing that [~ (X <= Y)] ensures that subtracting [Y] from [X]
    and then adding back [Y] produces [X], as needed by the second
    disjunct of (6). Note that [n - m + m = n] does _not_ hold for
    arbitrary natural numbers [n] and [m] (for example, [3 - 5 + 5 =
    5]). *)

(* ################################################################# *)
(** * Formal Decorated Programs *)

(** Our informal conventions for decorated programs amount to a
    way of displaying Hoare triples, in which commands are annotated
    with enough embedded assertions that checking the validity of a
    triple is reduced to simple logical and algebraic calculations
    showing that some assertions imply others.  In this section, we
    show that this informal presentation style can actually be made
    completely formal and indeed that checking the validity of
    decorated programs can mostly be automated.  *)

(* ================================================================= *)
(** ** Syntax *)

(** The first thing we need to do is to formalize a variant of the
    syntax of commands with embedded assertions.  We call the new
    commands _decorated commands_, or [dcom]s. *)

(** We don't want both preconditions and postconditions on each
    command, because a sequence of two commands would contain
    redundant decorations, the postcondition of the first likely
    being the same as the precondition of the second. Instead,
    decorations are added corresponding to each postcondition.
    A separate type, [decorated], is used to add the precondition
    for the entire program. **)

Inductive dcom : Type :=
| DCSkip (Q:  Assertion)
| DCSeq (d1 d2:  dcom)
| DCAsgn (X: string) (e: aexp) (Q: Assertion)
| DCIf (b: bexp) (P1: Assertion) (d1: dcom) (P2: Assertion) (d2: dcom) (Q: Assertion)
| DCWhile (b: bexp) (Pbody: Assertion) (body: dcom) (Q: Assertion)
| DCPre  (P: Assertion) (d: dcom)
| DCPost (d: dcom) (Q: Assertion).

Inductive decorated : Type :=
  | Decorated : Assertion -> dcom -> decorated.

Notation "'SKIP' {{ P }}"
      := (DCSkip P)
      (at level 10) : dcom_scope.
Notation "l '::=' a {{ P }}"
      := (DCAsgn l a P)
      (at level 60, a at next level) : dcom_scope.
Notation "'WHILE' b 'DO' {{ Pbody }} d 'END' {{ Ppost }}"
      := (DCWhile b Pbody d Ppost)
      (at level 80, right associativity) : dcom_scope.
Notation "'IFB' b 'THEN' {{ P }} d 'ELSE' {{ P' }} d' 'FI' {{ Q }}"
      := (DCIf b P d P' d' Q)
      (at level 80, right associativity)  : dcom_scope.
Notation "'->>' {{ P }} d"
      := (DCPre P d)
      (at level 90, right associativity)  : dcom_scope.
Notation "d '->>' {{ P }}"
      := (DCPost d P)
      (at level 80, right associativity)  : dcom_scope.
Notation " d ;; d' "
      := (DCSeq d d')
      (at level 80, right associativity)  : dcom_scope.
Notation "{{ P }} d"
      := (Decorated P d)
      (at level 90)  : dcom_scope.

Delimit Scope dcom_scope with dcom.
Open Scope dcom_scope.
(** To avoid clashing with the existing [Notation] definitions for
    ordinary [com]mands, we introduce these notations in a special
    scope called [dcom_scope], and we [Open] this scope for the
    remainder of the file.

    Careful readers will note that we've defined two notations
    for specifying a precondition explicitly, one with and one
    without a [->>].  The "without" version is intended to be
    used to supply the initial precondition at the very top
    of the program. *)

Example dec_while : decorated :=
  {{ fun st => True }}
  WHILE !(X =? 0)
  DO
    {{ fun st => True /\ st X <> 0}}
    X ::= X .- 1
    {{ fun _ => True }}
  END
  {{ fun st => True /\ st X = 0}} ->>
  {{ fun st => st X = 0 }}.

(** It is easy to go from a [dcom] to a [com] by erasing all
    annotations. *)

Fixpoint extract (d:dcom) : com :=
  match d with
  | DCSkip _           => SKIP
  | DCSeq d1 d2        => (extract d1 ;; extract d2)%com
  | DCAsgn X a _       => X ::= a
  | DCIf b _ d1 _ d2 _ => IFB b THEN extract d1 ELSE extract d2 FI
  | DCWhile b _ d _    => WHILE b DO extract d END
  | DCPre _ d          => extract d
  | DCPost d _         => extract d
  end.

Definition extract_dec (dec : decorated) : com :=
  match dec with
  | Decorated P d => extract d
  end.

Compute (extract_dec dec_while).

(** The choice of exactly where to put assertions in the definition of
    [dcom] is a bit subtle.  The simplest thing to do would be to
    annotate every [dcom] with a precondition and postcondition.  But
    this would result in very verbose programs with a lot of repeated
    annotations: for example, a program like [SKIP;SKIP] would have to
    be annotated as

        {{P}} ({{P}} SKIP {{P}}) ;; ({{P}} SKIP {{P}}) {{P}},

    with pre- and post-conditions on each [SKIP], plus identical pre-
    and post-conditions on the semicolon!

    Instead, the rule we've followed is this:

       - The _post_-condition expected by each [dcom] [d] is embedded
         in [d].

       - The _pre_-condition is supplied by the context. *)

(** In other words, the invariant of the representation is that a
    [dcom] [d] together with a precondition [P] determines a Hoare
    triple [{{P}} (extract d) {{post d}}], where [post] is defined as
    follows: *)

Fixpoint post (d:dcom) : Assertion :=
  match d with
  | DCSkip P                => P
  | DCSeq d1 d2             => post d2
  | DCAsgn X a Q            => Q
  | DCIf  _ _ d1 _ d2 Q     => Q
  | DCWhile b Pbody c Q     => Q
  | DCPre _ d               => post d
  | DCPost c Q              => Q
  end.

(** It is straightforward to extract the precondition and
    postcondition from a decorated program. *)

Definition pre_dec (dec : decorated) : Assertion :=
  match dec with
  | Decorated P d => P
  end.

Definition post_dec (dec : decorated) : Assertion :=
  match dec with
  | Decorated P d => post d
  end.

(** We can express what it means for a decorated program to be
    correct as follows: *)

Definition dec_correct (dec : decorated) :=
  {{pre_dec dec}} (extract_dec dec) {{post_dec dec}}.

(** To check whether this Hoare triple is _valid_, we need a way to
    extract the "proof obligations" from a decorated program.  These
    obligations are often called _verification conditions_, because
    they are the facts that must be verified to see that the
    decorations are logically consistent and thus add up to a complete
    proof of correctness. *)

(* ================================================================= *)
(** ** Extracting Verification Conditions *)

(** The function [verification_conditions] takes a [dcom] [d] together
    with a precondition [P] and returns a _proposition_ that, if it
    can be proved, implies that the triple [{{P}} (extract d) {{post d}}]
    is valid. *)

(** It does this by walking over [d] and generating a big
    conjunction including all the "local checks" that we listed when
    we described the informal rules for decorated programs.  (Strictly
    speaking, we need to massage the informal rules a little bit to
    add some uses of the rule of consequence, but the correspondence
    should be clear.) *)

Fixpoint VC (P : Assertion) (d:dcom)
                               : Prop :=
  match d with
  | DCSkip Q =>
    P ->> Q

  | DCSeq d1 d2 =>
    VC P d1
    /\ VC (post d1)  d2
  | DCAsgn X a Q =>
    P ->> Q [a // X]

  | DCIf b P1 d1 P2 d2 Q =>
    (fun st => P st /\ (bassn b) st) ->> P1
    /\ (fun st => P st /\ ~(bassn b) st) ->> P2
    /\ post d1 ->> Q
    /\ post d2 ->> Q
    /\ VC P1 d1
    /\ VC P2 d2

  | DCWhile b Pbody d Ppost =>
    P ->> post d
    /\ (fun st => (post d) st /\ (bassn b) st) ->> Pbody
    /\ (fun st => (post d) st /\ ~(bassn b) st) ->> Ppost
    /\ VC Pbody d

  | DCPre P' d =>
    P ->> P' /\ VC P' d
  | DCPost d Q =>
    VC P d /\ post d ->> Q
end.

(** And now the key theorem, stating that [verification_conditions]
    does its job correctly.  Not surprisingly, we need to use each of
    the Hoare Logic rules at some point in the proof. *)

Theorem verification_correct : forall d P,
  VC P d -> {{P}} (extract d) {{post d}}.
Proof.
  induction d; intros ? H; simpl in *.
  - (* Skip *)
    eapply hoare_weak_pre.
      apply hoare_skip.
      assumption.
  - (* Seq *)
    inversion H as [H1 H2]. clear H.
    eapply hoare_seq.
      apply IHd2. apply H2.
      apply IHd1. apply H1.
  - (* Asgn *)
    eapply hoare_weak_pre.
      apply hoare_asgn.
      assumption.
  - (* If *)
    inversion H as [HPre1 [HPre2 [Hd1 [Hd2 [HThen HElse]]]]].
    clear H.
    apply IHd1 in HThen. clear IHd1.
    apply IHd2 in HElse. clear IHd2.
    apply hoare_if.
      + eapply hoare_weak_post with (Q':=post d1); eauto.
         eapply hoare_weak_pre; eauto.
      + eapply hoare_weak_post with (Q':=post d2); eauto.
         eapply hoare_weak_pre; eauto.
  - (* While *)
    inversion H as [Hpre [Hbody1 [Hpost1  Hd]]]. clear H.
    eapply hoare_weak_pre; eauto.
    eapply hoare_weak_post; eauto.
    apply hoare_while.
    eapply hoare_weak_pre; eauto.
  - (* Pre *)
    inversion H as [HP Hd]; clear H.
    eapply hoare_weak_pre. apply IHd. apply Hd. assumption.
  - (* Post *)
    inversion H as [Hd HQ]; clear H.
    eapply hoare_weak_post. apply IHd. apply Hd. assumption.
Qed.

(* ================================================================= *)
(** ** Automation *)

(** Now that all the pieces are in place, we can verify an entire program. *)

Definition VC_dec (dec : decorated) : Prop :=
  match dec with
  | Decorated P d => VC P d
  end.

Lemma verification_correct_dec : forall dec,
  VC_dec dec -> dec_correct dec.
Proof.
  intros [P d]. apply verification_correct.
Qed.

(** The propositions generated by [verification_conditions] are fairly
    big, and they contain many conjuncts that are essentially trivial. *)

Eval simpl in (VC_dec dec_while).
(**

    ==>
    (((fun _ : state => True) ->> (fun _ : state => True)) /\
     ((fun st : state => True /\ bassn (! (X = 0)) st) ->>
      (fun st : state => True /\ st X <> 0)) /\
     ((fun st : state => True /\ ~ bassn (! (X = 0)) st) ->>
      (fun st : state => True /\ st X = 0)) /\
      (fun st : state => True /\ st X <> 0) ->>
      (fun _ : state => True) [X |-> X - 1]) /\
      (fun st : state => True /\ st X = 0) ->> (fun st : state => st X = 0)
*)

(** In principle, we could work with such propositions using just the
    tactics we have so far, but we can make things much smoother with
    a bit of automation.  We first define a custom [verify] tactic
    that uses [split] repeatedly to turn all the conjunctions into
    separate subgoals and then uses [omega] and [eauto] (described in
    chapter [Auto] in _Logical Foundations_) to deal with as many
    of them as possible. *)

(** Hint:
    bassn, assert_implies, assn_sub, t_update, beval, aeval
    not_true_iff_false
    not_false_iff_true
    negb_true_iff
    negb_false_iff
    beq_nat_true_iff
    beq_nat_false_iff
    leb_iff
    leb_iff_conv
 *)

(** What's left after [certify] does its thing is "just the interesting
    parts" of checking that the decorations are correct. For very
    simple examples [verify] immediately solves the goal (provided
    that the annotations are correct!). *)

Ltac verify :=
  intros;
  match goal with
  | [|- dec_correct _ ] =>
    apply verification_correct_dec;
    simpl; repeat split; my_simpl
  end.

Theorem dec_while_correct :
  dec_correct dec_while.
Proof.
  verify.
Qed.

(** Another example (formalizing a decorated program we've seen
    before): *)

Example subtract_slowly_dec (m:nat) (p:nat) : decorated :=
    {{ fun st => st X = m /\ st Z = p }} ->>
    {{ fun st => st Z - st X = p - m }}
  WHILE ! (X =? 0)
  DO   {{ fun st => st Z - st X = p - m /\ st X <> 0 }} ->>
       {{ fun st => (st Z - 1) - (st X - 1) = p - m }}
     Z ::= Z .- 1
       {{ fun st => st Z - (st X - 1) = p - m }} ;;
     X ::= X .- 1
       {{ fun st => st Z - st X = p - m }}
  END
    {{ fun st => st Z - st X = p - m /\ st X = 0 }} ->>
    {{ fun st => st Z = p - m }}.

Theorem subtract_slowly_dec_correct : forall m p,
    dec_correct (subtract_slowly_dec m p).
Proof.
  verify.
Qed.

(* ================================================================= *)
(** ** Examples *)

(** In this section, we use the automation developed above to verify
    formal decorated programs corresponding to most of the informal
    ones we have seen. *)

(* ----------------------------------------------------------------- *)
(** *** Swapping Using Addition and Subtraction *)

Definition swap : com :=
  (X ::= X .+ Y;;
  Y ::= X .- Y;;
  X ::= X .- Y)%com.

Definition swap_dec m n : decorated :=
   {{ fun st => st X = m /\ st Y = n}} ->>
   {{ fun st => (st X + st Y) - ((st X + st Y) - st Y) = n
                /\ (st X + st Y) - st Y = m }}
  X ::= X .+ Y
   {{ fun st => st X - (st X - st Y) = n /\ st X - st Y = m }};;
  Y ::= X .- Y
   {{ fun st => st X - st Y = n /\ st Y = m }};;
  X ::= X .- Y
   {{ fun st => st X = n /\ st Y = m}}.

Theorem swap_correct : forall m n,
    dec_correct (swap_dec m n).
Proof.
  verify.
Qed.

(* ----------------------------------------------------------------- *)
(** *** Simple Conditionals *)

Definition if_minus_plus_com :=
  IFB X <=? Y
    THEN Z ::= Y .- X
    ELSE Y ::= X .+ Z
  FI.

Definition if_minus_plus_dec :=
  {{fun st => True}}
  IFB X <=? Y  THEN
      {{ fun st => True /\ st X <= st Y }} ->>
      {{ fun st => st Y = st X + (st Y - st X) }}
    Z ::= Y .- X
      {{ fun st => st Y = st X + st Z }}
  ELSE
      {{ fun st => True /\ ~(st X <= st Y) }} ->>
      {{ fun st => st X + st Z = st X + st Z }}
    Y ::= X .+ Z
      {{ fun st => st Y = st X + st Z }}
  FI
  {{fun st => st Y = st X + st Z}}.

Theorem if_minus_plus_correct :
  dec_correct if_minus_plus_dec.
Proof.
  verify.
Qed.

Definition if_minus_dec :=
  {{fun st => True}}
  IFB X <=? Y THEN
      {{fun st => True /\ st X <= st Y }} ->>
      {{fun st => (st Y - st X) + st X = st Y
               \/ (st Y - st X) + st Y = st X}}
    Z ::= Y .- X
      {{fun st => st Z + st X = st Y \/ st Z + st Y = st X}}
  ELSE
      {{fun st => True /\ ~(st X <= st Y) }} ->>
      {{fun st => (st X - st Y) + st X = st Y
               \/ (st X - st Y) + st Y = st X}}
    Z ::= X .- Y
      {{fun st => st Z + st X = st Y \/ st Z + st Y = st X}}
  FI
    {{fun st => st Z + st X = st Y \/ st Z + st Y = st X}}.

Theorem if_minus_correct :
  dec_correct if_minus_dec.
Proof.
  verify.
Qed.

(* ----------------------------------------------------------------- *)
(** *** Division *)

Definition div_mod_dec (a b : nat) : decorated :=
  {{ fun st => True }} ->>
  {{ fun st => b * 0 + a = a }}
  X ::= a
  {{ fun st => b * 0 + st X = a }};;
  Y ::= 0
  {{ fun st => b * st Y + st X = a }};;
  WHILE b <=? X DO
    {{ fun st => b * st Y + st X = a /\ b <= st X }} ->>
    {{ fun st => b * (st Y + 1) + (st X - b) = a }}
    X ::= X .- b
    {{ fun st => b * (st Y + 1) + st X = a }};;
    Y ::= Y .+ 1
    {{ fun st => b * st Y + st X = a }}
  END
  {{ fun st => b * st Y + st X = a /\ ~(b <= st X) }} ->>
  {{ fun st => b * st Y + st X = a /\ (st X < b) }}.

Theorem div_mod_dec_correct : forall a b,
  dec_correct (div_mod_dec a b).
Proof.
  verify.
  rewrite mult_plus_distr_l. omega.
Qed.

(* ----------------------------------------------------------------- *)
(** *** Square Roots *)

Definition sqrt_dec m : decorated :=
    {{ fun st => st X = m }} ->>
    {{ fun st => st X = m /\ 0*0 <= m }}
  Z ::= 0
    {{ fun st => st X = m /\ st Z*st Z <= m }};;
  WHILE (Z.+1).*(Z.+1) <=? X DO
      {{ fun st => (st X = m /\ st Z*st Z<=m)
                   /\ (st Z + 1)*(st Z + 1) <= st X }} ->>
      {{ fun st => st X = m /\ (st Z+1)*(st Z+1)<=m }}
    Z ::= Z .+ 1
      {{ fun st => st X = m /\ st Z*st Z<=m }}
  END
    {{ fun st => (st X = m /\ st Z*st Z<=m)
                   /\ ~((st Z + 1)*(st Z + 1) <= st X) }} ->>
    {{ fun st => st Z*st Z<=m /\ m<(st Z+1)*(st Z+1) }}.

Theorem sqrt_correct : forall m,
  dec_correct (sqrt_dec m).
Proof. verify. Qed.

(* ----------------------------------------------------------------- *)
(** *** Two loops *)

Definition two_loops_dec (a b c : nat) : decorated :=
  {{ fun st => True }} ->>
  {{ fun st => c = 0 + c /\ 0 = 0 }}
  X ::= 0
  {{ fun st => c = st X + c /\ 0 = 0 }};;
  Y ::= 0
  {{ fun st => c = st X + c /\ st Y = 0 }};;
  Z ::= c
  {{ fun st => st Z = st X + c /\ st Y = 0 }};;
  WHILE !(X =? a) DO
    {{ fun st => (st Z = st X + c /\ st Y = 0) /\ st X <> a }} ->>
    {{ fun st => st Z + 1 = st X + 1 + c /\ st Y = 0 }}
    X ::= X .+ 1
    {{ fun st => st Z + 1 = st X + c /\ st Y = 0 }};;
    Z ::= Z .+ 1
    {{ fun st => st Z = st X + c /\ st Y = 0 }}
  END
  {{ fun st => (st Z = st X + c /\ st Y = 0) /\ st X = a }} ->>
  {{ fun st => st Z = a + st Y + c }};;
  WHILE !(Y =? b) DO
    {{ fun st => st Z = a + st Y + c /\ st Y <> b }} ->>
    {{ fun st => st Z + 1 = a + st Y + 1 + c }}
    Y ::= Y .+ 1
    {{ fun st => st Z + 1 = a + st Y + c }};;
    Z ::= Z .+ 1
    {{ fun st => st Z = a + st Y + c }}
  END
  {{ fun st => (st Z = a + st Y + c) /\ st Y = b }} ->>
  {{ fun st => st Z = a + b + c }}.

Theorem two_loops_correct : forall a b c,
  dec_correct (two_loops_dec a b c).
Proof. verify. Qed.

author: VeriGu


text:
(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(****************************************************************************

          IEEE754  :  Rpower

          Laurent Thery

  *****************************************************************************
  Definition of an exponential function over relative numbers *)
Require Import Omega.
Require Import Reals.
Require Import Zpower.
Require Import ZArith.
Require Import Digit.
Require Import Faux.
Require Import sTactic.
(* We have already an exponential over natural number,
   we prove some basic properties for this function *)

Theorem pow_O : forall e : R, (e ^ 0)%R = 1%R.
simpl in |- *; auto with real.
Qed.

Theorem pow_1 : forall e : R, (e ^ 1)%R = e.
simpl in |- *; auto with real.
Qed.

Theorem pow_NR0 : forall (e : R) (n : nat), e <> 0%R -> (e ^ n)%R <> 0%R.
intros e n; elim n; simpl in |- *; auto with real.
Qed.

Theorem pow_add :
 forall (e : R) (n m : nat), (e ^ (n + m))%R = (e ^ n * e ^ m)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' m; rewrite H'; auto with real.
Qed.
Hint Resolve pow_O pow_1 pow_NR0 pow_add: real.

Theorem pow_RN_plus :
 forall (e : R) (n m : nat),
 e <> 0%R -> (e ^ n)%R = (e ^ (n + m) * / e ^ m)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' m H'0.
rewrite Rmult_assoc; rewrite <- H'; auto.
Qed.

Theorem pow_lt : forall (e : R) (n : nat), (0 < e)%R -> (0 < e ^ n)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' H'0; replace 0%R with (e * 0)%R; auto with real.
Qed.
Hint Resolve pow_lt: real.

Theorem Rlt_pow_R1 :
 forall (e : R) (n : nat), (1 < e)%R -> 0 < n -> (1 < e ^ n)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros H' H'0; Contradict H'0; auto with arith.
intros n0; case n0.
simpl in |- *; rewrite Rmult_1_r; auto.
intros n1 H' H'0 H'1.
replace 1%R with (1 * 1)%R; auto with real.
apply Rlt_trans with (r2 := (e * 1)%R); auto with real.
apply Rmult_lt_compat_l; auto with real.
apply Rlt_trans with (r2 := 1%R); auto with real.
apply H'; auto with arith.
Qed.
Hint Resolve Rlt_pow_R1: real.

Theorem Rlt_pow :
 forall (e : R) (n m : nat), (1 < e)%R -> n < m -> (e ^ n < e ^ m)%R.
intros e n m H' H'0; replace m with (m - n + n).
rewrite pow_add.
pattern (e ^ n)%R at 1 in |- *; replace (e ^ n)%R with (1 * e ^ n)%R;
 auto with real.
apply Rminus_lt.
repeat rewrite (fun x : R => Rmult_comm x (e ^ n));
 rewrite <- Rmult_minus_distr_l.
replace 0%R with (e ^ n * 0)%R; auto with real.
apply Rmult_lt_compat_l; auto with real.
apply pow_lt; auto with real.
apply Rlt_trans with (r2 := 1%R); auto with real.
apply Rlt_minus; auto with real.
apply Rlt_pow_R1; auto with arith.
apply plus_lt_reg_l with (p := n); auto with arith.
rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
rewrite plus_comm; auto with arith.
Qed.
Hint Resolve Rlt_pow: real.

Theorem pow_R1 :
 forall (r : R) (n : nat), (r ^ n)%R = 1%R -> Rabs r = 1%R \/ n = 0.
intros r n H'.
case (Req_dec (Rabs r) 1); auto; intros H'1.
case (Rdichotomy _ _ H'1); intros H'2.
generalize H'; case n; auto.
intros n0 H'0.
cut (r <> 0%R); [ intros Eq1 | idtac ].
2: Contradict H'0; auto with arith.
2: simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real.
cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0)%R; auto.
replace (Rabs (/ r) ^ S n0)%R with 1%R.
simpl in |- *; apply Rlt_irrefl; auto.
rewrite Rabs_Rinv; auto.
rewrite <- Rinv_pow; auto.
rewrite RPow_abs; auto.
rewrite H'0; rewrite Rabs_right; auto with real.
apply Rlt_pow; auto with arith.
rewrite Rabs_Rinv; auto.
apply Rmult_lt_reg_l with (r := Rabs r).
case (Rabs_pos r); auto.
intros H'3; case Eq2; auto.
rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
generalize H'; case n; auto.
intros n0 H'0.
cut (r <> 0%R); [ intros Eq1 | auto with real ].
2: Contradict H'0; simpl in |- *; rewrite H'0; rewrite Rmult_0_l;
    auto with real.
cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
absurd (Rabs r ^ 0 < Rabs r ^ S n0)%R; auto with real arith.
repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
Qed.

Theorem Zpower_NR0 :
 forall (e : BinInt.Z) (n : nat), (0 <= e)%Z -> (0 <= Zpower_nat e n)%Z.
intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *;
 auto with zarith.
Qed.

Theorem Zpower_NR1 :
 forall (e : BinInt.Z) (n : nat), (1 <= e)%Z -> (1 <= Zpower_nat e n)%Z.
intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *;
 auto with zarith.
Qed.
Hint Resolve Zpower_NR0 Zpower_NR1: zarith.
(* To define exponential over relative number, we simply do
   a case analysis on the sign of the number *)

Definition powerRZ (e : R) (n : BinInt.Z) :=
  match n with
  | BinInt.Z0 => 1%R
  | BinInt.Zpos p => (e ^ BinPos.nat_of_P p)%R
  | BinInt.Zneg p => (/ e ^ BinPos.nat_of_P p)%R
  end.
(* we now prove some basic properties of our exponential *)

Theorem powerRZ_O : forall e : R, powerRZ e 0 = 1%R.
simpl in |- *; auto.
Qed.

Theorem powerRZ_1 : forall e : R, powerRZ e (Zsucc 0) = e.
simpl in |- *; auto with real.
Qed.

Theorem powerRZ_NOR :
 forall (e : R) (z : BinInt.Z), e <> 0%R -> powerRZ e z <> 0%R.
intros e z; case z; simpl in |- *; auto with real.
Qed.
Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR: real.

Theorem powerRZ_add :
 forall (e : R) (n m : BinInt.Z),
 e <> 0%R -> powerRZ e (n + m) = (powerRZ e n * powerRZ e m)%R.
intros e n m; case n; case m; simpl in |- *; auto with real.
intros n1 m1; rewrite Pnat.nat_of_P_plus_morphism; auto with real.
intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare m1 n1 Datatypes.Eq); simpl in |- *;
 auto with real.
intros H' H'0; rewrite BinPos.Pcompare_Eq_eq with (1 := H'); auto with real.
intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism n1 m1); auto with real.
rewrite
 (pow_RN_plus e (BinPos.nat_of_P n1 - BinPos.nat_of_P m1)
    (BinPos.nat_of_P m1)); auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
rewrite Rinv_mult_distr; auto with real.
rewrite Rinv_involutive; auto with real.
apply lt_le_weak.
apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto.
apply BinPos.ZC2; auto.
intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism m1 n1); auto with real.
rewrite
 (pow_RN_plus e (BinPos.nat_of_P m1 - BinPos.nat_of_P n1)
    (BinPos.nat_of_P n1)); auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
apply lt_le_weak.
change (BinPos.nat_of_P m1 > BinPos.nat_of_P n1) in |- *.
apply Pnat.nat_of_P_gt_Gt_compare_morphism; auto.
intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare n1 m1 Datatypes.Eq); simpl in |- *;
 auto with real.
intros H' H'0; rewrite BinPos.Pcompare_Eq_eq with (1 := H'); auto with real.
intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism m1 n1); auto with real.
rewrite
 (pow_RN_plus e (BinPos.nat_of_P m1 - BinPos.nat_of_P n1)
    (BinPos.nat_of_P n1)); auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
rewrite Rinv_mult_distr; auto with real.
apply lt_le_weak.
apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto.
apply BinPos.ZC2; auto.
intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism n1 m1); auto with real.
rewrite
 (pow_RN_plus e (BinPos.nat_of_P n1 - BinPos.nat_of_P m1)
    (BinPos.nat_of_P m1)); auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
apply lt_le_weak.
change (BinPos.nat_of_P n1 > BinPos.nat_of_P m1) in |- *.
apply Pnat.nat_of_P_gt_Gt_compare_morphism; auto.
intros n1 m1; rewrite Pnat.nat_of_P_plus_morphism; auto with real.
intros H'; rewrite pow_add; auto with real.
apply Rinv_mult_distr; auto.
apply pow_NR0; auto.
apply pow_NR0; auto.
Qed.
Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.

Theorem powerRZ_Zopp :
 forall (e : R) (z : BinInt.Z),
 e <> 0%R -> powerRZ e (- z) = (/ powerRZ e z)%R.
intros e z H; case z; simpl in |- *; auto with real.
intros p; apply sym_eq; apply Rinv_involutive.
apply pow_nonzero; auto.
Qed.

Theorem powerRZ_Zs :
 forall (e : R) (n : BinInt.Z),
 e <> 0%R -> powerRZ e (Zsucc n) = (e * powerRZ e n)%R.
intros e n H'0.
replace (Zsucc n) with (n + Zsucc 0)%Z.
rewrite powerRZ_add; auto.
rewrite powerRZ_1.
rewrite Rmult_comm; auto.
auto with zarith.
Qed.
(* Conversion theorem between relative numbers and reals *)

Theorem Zpower_nat_powerRZ :
 forall (n : BinInt.Z) (m : nat),
 IZR (Zpower_nat n m) = powerRZ (IZR n) (Z_of_nat m).
intros n m; elim m; simpl in |- *; auto with real.
intros m1 H'; rewrite Pnat.nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
replace (Zpower_nat n (S m1)) with (n * Zpower_nat n m1)%Z.
rewrite Rmult_IZR; auto with real.
rewrite H'; simpl in |- *.
case m1; simpl in |- *; auto with real.
intros m2; rewrite Pnat.nat_of_P_o_P_of_succ_nat_eq_succ; auto.
unfold Zpower_nat in |- *; auto.
Qed.

Theorem powerRZ_lt :
 forall (e : R) (z : BinInt.Z), (0 < e)%R -> (0 < powerRZ e z)%R.
intros e z; case z; simpl in |- *; auto with real.
Qed.
Hint Resolve powerRZ_lt: real.

Theorem powerRZ_le :
 forall (e : R) (z : BinInt.Z), (0 < e)%R -> (0 <= powerRZ e z)%R.
intros e z H'; apply Rlt_le; auto with real.
Qed.
Hint Resolve powerRZ_le: real.

Theorem Rlt_powerRZ :
 forall (e : R) (n m : BinInt.Z),
 (1 < e)%R -> (n < m)%Z -> (powerRZ e n < powerRZ e m)%R.
intros e n m; case n; case m; simpl in |- *;
 try (unfold Zlt in |- *; intros; discriminate); auto with real.
intros p p0 H' H'0; apply Rlt_pow; auto with real.
apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto.
intros p H' H'0; replace 1%R with (/ 1)%R; auto with real.
intros p p0 H' H'0; apply Rlt_trans with (r2 := 1%R).
replace 1%R with (/ 1)%R; auto with real.
apply Rlt_pow_R1; auto with real.
intros p p0 H' H'0; apply Rinv_1_lt_contravar; auto with real.
apply Rlt_pow; auto with real.
apply Pnat.nat_of_P_lt_Lt_compare_morphism; rewrite BinPos.ZC4; auto.
Qed.
Hint Resolve Rlt_powerRZ: real.

Theorem Rpow_R1 :
 forall (r : R) (z : BinInt.Z),
 r <> 0%R -> powerRZ r z = 1%R -> Rabs r = 1%R \/ z = 0%Z.
intros r z; case z; simpl in |- *; auto; intros p H' H'1; left.
case (pow_R1 _ _ H'1); auto.
intros H'0; Contradict H'0; auto with zarith; apply convert_not_O.
rewrite Rinv_pow in H'1; auto.
case (pow_R1 _ _ H'1); auto.
intros H'0.
rewrite <- H'0.
apply Rmult_eq_reg_l with (r := 1%R); auto with real.
pattern 1%R at 1 in |- *; rewrite <- H'0; auto with real.
pattern (Rabs (/ r)) at 1 in |- *; rewrite Rabs_Rinv; try rewrite Rinv_l;
 auto with real.
rewrite H'0; auto with real.
apply Rabs_no_R0; auto.
intros H'0; Contradict H'0; auto with zarith; apply convert_not_O.
Qed.

Theorem Rpow_eq_inv :
 forall (r : R) (p q : BinInt.Z),
 r <> 0%R -> Rabs r <> 1%R -> powerRZ r p = powerRZ r q -> p = q.
intros r p q H' H'0 H'1.
cut (powerRZ r (p - q) = 1%R); [ intros Eq0 | idtac ].
case (Rpow_R1 _ _ H' Eq0); auto with zarith.
intros H'2; case H'0; auto.
apply Rmult_eq_reg_l with (r := powerRZ r q); auto with real.
rewrite <- powerRZ_add; auto.
replace (q + (p - q))%Z with p; auto with zarith.
rewrite <- H'1; rewrite Rmult_1_r; auto with arith.
Qed.

Theorem Zpower_nat_powerRZ_absolu :
 forall n m : BinInt.Z,
 (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = powerRZ (IZR n) m.
intros n m; case m; simpl in |- *; auto with zarith.
intros p H'; elim (BinPos.nat_of_P p); simpl in |- *; auto with zarith.
intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
rewrite <- Rmult_IZR; auto.
intros p H'; Contradict H'; auto with zarith.
Qed.

Theorem powerRZ_R1 : forall n : BinInt.Z, powerRZ 1 n = 1%R.
intros n; case n; simpl in |- *; auto.
intros p; elim (BinPos.nat_of_P p); simpl in |- *; auto; intros n0 H';
 rewrite H'; ring.
intros p; elim (BinPos.nat_of_P p); simpl in |- *.
exact Rinv_1.
intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
 auto with real.
Qed.

Theorem Rle_powerRZ :
 forall (e : R) (n m : BinInt.Z),
 (1 <= e)%R -> (n <= m)%Z -> (powerRZ e n <= powerRZ e m)%R.
intros e n m H' H'0.
case H'; intros E1.
case (Zle_lt_or_eq _ _ H'0); intros E2.
apply Rlt_le; auto with real.
rewrite <- E2; auto with real.
repeat rewrite <- E1; repeat rewrite powerRZ_R1; auto with real.
Qed.

Theorem Zlt_powerRZ :
 forall (e : R) (n m : BinInt.Z),
 (1 <= e)%R -> (powerRZ e n < powerRZ e m)%R -> (n < m)%Z.
intros e n m H' H'0.
case (Zle_or_lt m n); auto; intros Z1.
Contradict H'0.
apply Rle_not_lt.
apply Rle_powerRZ; auto.
Qed.

author: coq-contribs

repo: float

save_path: github-repos/coq/coq-contribs-float


text:
Require Import PPS.Exercises.Imp_5_Ref PPS.Env.

Notation "EM '|-R' e ⇓ v" := (evalR EM e v) (at level 80).
Notation "M '[' var ↦ val ']'" := (updateTMap ref_eqb M var val)
                                    (at level 40, right associativity).

Definition x := 0.
Definition y := 1.
Definition E : Env := cons (y, (RefAddr 32, Numeric Int))
                           (cons (x, (RefAddr 42, Numeric Int)) nil).

(* Definition upd := @updateTMap Ref Val ref_eqb. *)

Definition M : Memory :=
  (emptyTMap Undefined) [ RefAddr 42 ↦ VNum (VInt 2) ] [ RefAddr 32 ↦ VNum (VInt 5) ].

Definition exp : Exp := Op (Op (Num (VInt 3)) mult (Var (Numeric Int) y))
                           plus
                           (Var (Numeric Int) x).

Example e : (E,M) |-R exp ⇓ VNum (VInt 17).
Proof.
  unfold exp.
  apply EvPlusR with (v1 := VInt 15) (v2 := VInt 2) (tau := Int).
  - apply EvMultR with (v1 := VInt 3) (v2 := VInt 5) (tau := Int).
    + apply EvNumR.
    + apply EvVarR with (l := RefAddr 32).
      * apply LAxiom.
      * reflexivity.
    + apply EvTMult.
      * apply EvTInt.
      * apply EvTVar with (l := RefAddr 32).
        apply LAxiom.
    + reflexivity.
  - apply EvVarR with (l := RefAddr 42).
    + apply LRule.
      apply LAxiom.
    + reflexivity.
  - apply EvTPlus.
    + apply EvTMult.
      * apply EvTInt.
      * apply EvTVar with (l := RefAddr 32).
        apply LAxiom.
    + apply EvTVar with (l := RefAddr 42).
      apply LRule.
      apply LAxiom.
  - reflexivity.
Qed.

Example e2 : (E,M) |-R exp ⇓ VNum (VInt 17).
Proof. repeat econstructor. Qed.

author: nbun

repo: pps-coq

save_path: github-repos/coq/nbun-pps-coq


text:
From Hammer Require Import Hammer.

Require Import Decidable Setoid DecidableTypeEx FSetFacts.

Module WDecide_fun (E : DecidableType)(Import M : WSfun E).
Module F := FSetFacts.WFacts_fun E M.

Module FSetLogicalFacts.
Export Decidable.
Export Setoid.

Tactic Notation "fold" "any" "not" :=
repeat (
match goal with
| H: context [?P -> False] |- _ =>
fold (~ P) in H
| |- context [?P -> False] =>
fold (~ P)
end).

Ltac or_not_l_iff P Q tac :=
(rewrite (or_not_l_iff_1 P Q) by tac) ||
(rewrite (or_not_l_iff_2 P Q) by tac).

Ltac or_not_r_iff P Q tac :=
(rewrite (or_not_r_iff_1 P Q) by tac) ||
(rewrite (or_not_r_iff_2 P Q) by tac).

Ltac or_not_l_iff_in P Q H tac :=
(rewrite (or_not_l_iff_1 P Q) in H by tac) ||
(rewrite (or_not_l_iff_2 P Q) in H by tac).

Ltac or_not_r_iff_in P Q H tac :=
(rewrite (or_not_r_iff_1 P Q) in H by tac) ||
(rewrite (or_not_r_iff_2 P Q) in H by tac).

Tactic Notation "push" "not" "using" ident(db) :=
let dec := solve_decidable using db in
unfold not, iff;
repeat (
match goal with
| |- context [True -> False] => rewrite not_true_iff
| |- context [False -> False] => rewrite not_false_iff
| |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec
| |- context [(?P -> False) -> (?Q -> False)] =>
rewrite (contrapositive P Q) by dec
| |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec
| |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec
| |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec
| |- context [?P \/ ?Q -> False] => rewrite (not_or_iff P Q)
| |- context [?P /\ ?Q -> False] => rewrite (not_and_iff P Q)
| |- context [(?P -> ?Q) -> False] => rewrite (not_imp_iff P Q) by dec
end);
fold any not.

Tactic Notation "push" "not" :=
push not using core.

Tactic Notation
"push" "not" "in" "*" "|-" "using" ident(db) :=
let dec := solve_decidable using db in
unfold not, iff in * |-;
repeat (
match goal with
| H: context [True -> False] |- _ => rewrite not_true_iff in H
| H: context [False -> False] |- _ => rewrite not_false_iff in H
| H: context [(?P -> False) -> False] |- _ =>
rewrite (not_not_iff P) in H by dec
| H: context [(?P -> False) -> (?Q -> False)] |- _ =>
rewrite (contrapositive P Q) in H by dec
| H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec
| H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec
| H: context [(?P -> False) -> ?Q] |- _ =>
rewrite (imp_not_l P Q) in H by dec
| H: context [?P \/ ?Q -> False] |- _ => rewrite (not_or_iff P Q) in H
| H: context [?P /\ ?Q -> False] |- _ => rewrite (not_and_iff P Q) in H
| H: context [(?P -> ?Q) -> False] |- _ =>
rewrite (not_imp_iff P Q) in H by dec
end);
fold any not.

Tactic Notation "push" "not" "in" "*" "|-"  :=
push not in * |- using core.

Tactic Notation "push" "not" "in" "*" "using" ident(db) :=
push not using db; push not in * |- using db.
Tactic Notation "push" "not" "in" "*" :=
push not in * using core.

Lemma test_push : forall P Q R : Prop,
decidable P ->
decidable Q ->
(~ True) ->
(~ False) ->
(~ ~ P) ->
(~ (P /\ Q) -> ~ R) ->
((P /\ Q) \/ ~ R) ->
(~ (P /\ Q) \/ R) ->
(R \/ ~ (P /\ Q)) ->
(~ R \/ (P /\ Q)) ->
(~ P -> R) ->
(~ ((R -> P) \/ (Q -> R))) ->
(~ (P /\ R)) ->
(~ (P -> R)) ->
True.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetLogicalFacts.test_push".
intros. push not in *.

tauto.
Qed.

Tactic Notation "pull" "not" "using" ident(db) :=
let dec := solve_decidable using db in
unfold not, iff;
repeat (
match goal with
| |- context [True -> False] => rewrite not_true_iff
| |- context [False -> False] => rewrite not_false_iff
| |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec
| |- context [(?P -> False) -> (?Q -> False)] =>
rewrite (contrapositive P Q) by dec
| |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec
| |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec
| |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec
| |- context [(?P -> False) /\ (?Q -> False)] =>
rewrite <- (not_or_iff P Q)
| |- context [?P -> ?Q -> False] => rewrite <- (not_and_iff P Q)
| |- context [?P /\ (?Q -> False)] => rewrite <- (not_imp_iff P Q) by dec
| |- context [(?Q -> False) /\ ?P] =>
rewrite <- (not_imp_rev_iff P Q) by dec
end);
fold any not.

Tactic Notation "pull" "not" :=
pull not using core.

Tactic Notation
"pull" "not" "in" "*" "|-" "using" ident(db) :=
let dec := solve_decidable using db in
unfold not, iff in * |-;
repeat (
match goal with
| H: context [True -> False] |- _ => rewrite not_true_iff in H
| H: context [False -> False] |- _ => rewrite not_false_iff in H
| H: context [(?P -> False) -> False] |- _ =>
rewrite (not_not_iff P) in H by dec
| H: context [(?P -> False) -> (?Q -> False)] |- _ =>
rewrite (contrapositive P Q) in H by dec
| H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec
| H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec
| H: context [(?P -> False) -> ?Q] |- _ =>
rewrite (imp_not_l P Q) in H by dec
| H: context [(?P -> False) /\ (?Q -> False)] |- _ =>
rewrite <- (not_or_iff P Q) in H
| H: context [?P -> ?Q -> False] |- _ =>
rewrite <- (not_and_iff P Q) in H
| H: context [?P /\ (?Q -> False)] |- _ =>
rewrite <- (not_imp_iff P Q) in H by dec
| H: context [(?Q -> False) /\ ?P] |- _ =>
rewrite <- (not_imp_rev_iff P Q) in H by dec
end);
fold any not.

Tactic Notation "pull" "not" "in" "*" "|-"  :=
pull not in * |- using core.

Tactic Notation "pull" "not" "in" "*" "using" ident(db) :=
pull not using db; pull not in * |- using db.
Tactic Notation "pull" "not" "in" "*" :=
pull not in * using core.

Lemma test_pull : forall P Q R : Prop,
decidable P ->
decidable Q ->
(~ True) ->
(~ False) ->
(~ ~ P) ->
(~ (P /\ Q) -> ~ R) ->
((P /\ Q) \/ ~ R) ->
(~ (P /\ Q) \/ R) ->
(R \/ ~ (P /\ Q)) ->
(~ R \/ (P /\ Q)) ->
(~ P -> R) ->
(~ (R -> P) /\ ~ (Q -> R)) ->
(~ P \/ ~ R) ->
(P /\ ~ R) ->
(~ R /\ P) ->
True.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetLogicalFacts.test_pull".
intros. pull not in *. tauto.
Qed.

End FSetLogicalFacts.
Import FSetLogicalFacts.

Module FSetDecideAuxiliary.

Ltac no_logical_interdep :=
match goal with
| H : ?P |- _ =>
match type of P with
| Prop =>
match goal with H' : context [ H ] |- _ => clear dependent H' end
| _ => fail
end; no_logical_interdep
| _ => idtac
end.

Ltac abstract_term t :=
tryif (is_var t) then fail "no need to abstract a variable"
else (let x := fresh "x" in set (x := t) in *; try clearbody x).

Ltac abstract_elements :=
repeat
(match goal with
| |- context [ singleton ?t ] => abstract_term t
| _ : context [ singleton ?t ] |- _ => abstract_term t
| |- context [ add ?t _ ] => abstract_term t
| _ : context [ add ?t _ ] |- _ => abstract_term t
| |- context [ remove ?t _ ] => abstract_term t
| _ : context [ remove ?t _ ] |- _ => abstract_term t
| |- context [ In ?t _ ] => abstract_term t
| _ : context [ In ?t _ ] |- _ => abstract_term t
end).

Tactic Notation "prop" constr(P) "holds" "by" tactic(t) :=
let H := fresh in
assert P as H by t;
clear H.

Tactic Notation "assert" "new" constr(e) "by" tactic(t) :=
match goal with
| H: e |- _ => fail 1
| _ => assert e by t
end.

Tactic Notation "subst" "++" :=
repeat (
match goal with
| x : _ |- _ => subst x
end);
cbv zeta beta in *.

Tactic Notation "decompose" "records" :=
repeat (
match goal with
| H: _ |- _ => progress (decompose record H); clear H
end).

Inductive FSet_elt_Prop : Prop -> Prop :=
| eq_Prop : forall (S : Type) (x y : S),
FSet_elt_Prop (x = y)
| eq_elt_prop : forall x y,
FSet_elt_Prop (E.eq x y)
| In_elt_prop : forall x s,
FSet_elt_Prop (In x s)
| True_elt_prop :
FSet_elt_Prop True
| False_elt_prop :
FSet_elt_Prop False
| conj_elt_prop : forall P Q,
FSet_elt_Prop P ->
FSet_elt_Prop Q ->
FSet_elt_Prop (P /\ Q)
| disj_elt_prop : forall P Q,
FSet_elt_Prop P ->
FSet_elt_Prop Q ->
FSet_elt_Prop (P \/ Q)
| impl_elt_prop : forall P Q,
FSet_elt_Prop P ->
FSet_elt_Prop Q ->
FSet_elt_Prop (P -> Q)
| not_elt_prop : forall P,
FSet_elt_Prop P ->
FSet_elt_Prop (~ P).

Inductive FSet_Prop : Prop -> Prop :=
| elt_FSet_Prop : forall P,
FSet_elt_Prop P ->
FSet_Prop P
| Empty_FSet_Prop : forall s,
FSet_Prop (Empty s)
| Subset_FSet_Prop : forall s1 s2,
FSet_Prop (Subset s1 s2)
| Equal_FSet_Prop : forall s1 s2,
FSet_Prop (Equal s1 s2).

Hint Constructors FSet_elt_Prop FSet_Prop : FSet_Prop.
Ltac discard_nonFSet :=
repeat (
match goal with
| H : context [ @Logic.eq ?T ?x ?y ] |- _ =>
tryif (change T with E.t in H) then fail
else tryif (change T with t in H) then fail
else clear H
| H : ?P |- _ =>
tryif prop (FSet_Prop P) holds by
(auto 100 with FSet_Prop)
then fail
else clear H
end).

Hint Rewrite
F.empty_iff F.singleton_iff F.add_iff F.remove_iff
F.union_iff F.inter_iff F.diff_iff
: set_simpl.

Lemma eq_refl_iff (x : E.t) : E.eq x x <-> True.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideAuxiliary.eq_refl_iff".
now split.
Qed.

Hint Rewrite eq_refl_iff : set_eq_simpl.

Lemma dec_In : forall x s,
decidable (In x s).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideAuxiliary.dec_In".
red; intros; generalize (F.mem_iff s x); case (mem x s); intuition.
Qed.

Lemma dec_eq : forall (x y : E.t),
decidable (E.eq x y).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideAuxiliary.dec_eq".
red; intros x y; destruct (E.eq_dec x y); auto.
Qed.

Hint Resolve dec_In dec_eq : FSet_decidability.

Ltac change_to_E_t :=
repeat (
match goal with
| H : ?T |- _ =>
progress (change T with E.t in H);
repeat (
match goal with
| J : _ |- _ => progress (change T with E.t in J)
| |- _ => progress (change T with E.t)
end )
| H : forall x : ?T, _ |- _ =>
progress (change T with E.t in H);
repeat (
match goal with
| J : _ |- _ => progress (change T with E.t in J)
| |- _ => progress (change T with E.t)
end )
end).

Ltac Logic_eq_to_E_eq :=
repeat (
match goal with
| H: _ |- _ =>
progress (change (@Logic.eq E.t) with E.eq in H)
| |- _ =>
progress (change (@Logic.eq E.t) with E.eq)
end).

Ltac E_eq_to_Logic_eq :=
repeat (
match goal with
| H: _ |- _ =>
progress (change E.eq with (@Logic.eq E.t) in H)
| |- _ =>
progress (change E.eq with (@Logic.eq E.t))
end).

Ltac substFSet :=
repeat (
match goal with
| H: E.eq ?x ?x |- _ => clear H
| H: E.eq ?x ?y |- _ => rewrite H in *; clear H
end);
autorewrite with set_eq_simpl in *.

Ltac assert_decidability :=

repeat (
match goal with
| H: context [~ E.eq ?x ?y] |- _ =>
assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
| H: context [~ In ?x ?s] |- _ =>
assert new (In x s \/ ~ In x s) by (apply dec_In)
| |- context [~ E.eq ?x ?y] =>
assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
| |- context [~ In ?x ?s] =>
assert new (In x s \/ ~ In x s) by (apply dec_In)
end);

repeat (
match goal with
| _: ~ ?P, H : ?P \/ ~ ?P |- _ => clear H
end).

Ltac inst_FSet_hypotheses :=
repeat (
match goal with
| H : forall a : E.t, _,
_ : context [ In ?x _ ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ In ?x _ ] =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _,
_ : context [ E.eq ?x _ ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ E.eq ?x _ ] =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _,
_ : context [ E.eq _ ?x ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ E.eq _ ?x ] =>
let P := type of (H x) in
assert new P by (exact (H x))
end);
repeat (
match goal with
| H : forall a : E.t, _ |- _ =>
clear H
end).

Ltac fsetdec_rec := progress substFSet; intuition fsetdec_rec.

Ltac fsetdec_body :=
autorewrite with set_eq_simpl in *;
inst_FSet_hypotheses;
autorewrite with set_simpl set_eq_simpl in *;
push not in * using FSet_decidability;
substFSet;
assert_decidability;
auto;
(intuition fsetdec_rec) ||
fail 1
"because the goal is beyond the scope of this tactic".

End FSetDecideAuxiliary.
Import FSetDecideAuxiliary.

Ltac fsetdec :=

unfold iff in *;

fold any not; intros;

abstract_elements;

no_logical_interdep;

decompose records;
discard_nonFSet;

unfold Empty, Subset, Equal in *; intros;

change_to_E_t; E_eq_to_Logic_eq; subst++; Logic_eq_to_E_eq;

pull not using FSet_decidability;
unfold not in *;
match goal with
| H: (In ?x ?r) -> False |- (In ?x ?s) -> False =>
contradict H; fsetdec_body
| H: (In ?x ?r) -> False |- (E.eq ?x ?y) -> False =>
contradict H; fsetdec_body
| H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False =>
contradict H; fsetdec_body
| H: ?P -> False |- ?Q -> False =>
tryif prop (FSet_elt_Prop P) holds by
(auto 100 with FSet_Prop)
then (contradict H; fsetdec_body)
else fsetdec_body
| |- _ =>
fsetdec_body
end.

Module FSetDecideTestCases.

Lemma test_eq_trans_1 : forall x y z s,
E.eq x y ->
~ ~ E.eq z y ->
In x s ->
In z s.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_eq_trans_1".   fsetdec. Qed.

Lemma test_eq_trans_2 : forall x y z r s,
In x (singleton y) ->
~ In z r ->
~ ~ In z (add y r) ->
In x s ->
In z s.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_eq_trans_2".   fsetdec. Qed.

Lemma test_eq_neq_trans_1 : forall w x y z s,
E.eq x w ->
~ ~ E.eq x y ->
~ E.eq y z ->
In w s ->
In w (remove z s).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_eq_neq_trans_1".   fsetdec. Qed.

Lemma test_eq_neq_trans_2 : forall w x y z r1 r2 s,
In x (singleton w) ->
~ In x r1 ->
In x (add y r1) ->
In y r2 ->
In y (remove z r2) ->
In w s ->
In w (remove z s).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_eq_neq_trans_2".   fsetdec. Qed.

Lemma test_In_singleton : forall x,
In x (singleton x).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_In_singleton".   fsetdec. Qed.

Lemma test_add_In : forall x y s,
In x (add y s) ->
~ E.eq x y ->
In x s.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_add_In".   fsetdec. Qed.

Lemma test_Subset_add_remove : forall x s,
s [<=] (add x (remove x s)).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_Subset_add_remove".   fsetdec. Qed.

Lemma test_eq_disjunction : forall w x y z,
In w (add x (add y (singleton z))) ->
E.eq w x \/ E.eq w y \/ E.eq w z.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_eq_disjunction".   fsetdec. Qed.

Lemma test_not_In_disj : forall x y s1 s2 s3 s4,
~ In x (union s1 (union s2 (union s3 (add y s4)))) ->
~ (In x s1 \/ In x s4 \/ E.eq y x).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_not_In_disj".   fsetdec. Qed.

Lemma test_not_In_conj : forall x y s1 s2 s3 s4,
~ In x (union s1 (union s2 (union s3 (add y s4)))) ->
~ In x s1 /\ ~ In x s4 /\ ~ E.eq y x.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_not_In_conj".   fsetdec. Qed.

Lemma test_iff_conj : forall a x s s',
(In a s' <-> E.eq x a \/ In a s) ->
(In a s' <-> In a (add x s)).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_iff_conj".   fsetdec. Qed.

Lemma test_set_ops_1 : forall x q r s,
(singleton x) [<=] s ->
Empty (union q r) ->
Empty (inter (diff s q) (diff s r)) ->
~ In x s.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_set_ops_1".   fsetdec. Qed.

Lemma eq_chain_test : forall x1 x2 x3 x4 s1 s2 s3 s4,
Empty s1 ->
In x2 (add x1 s1) ->
In x3 s2 ->
~ In x3 (remove x2 s2) ->
~ In x4 s3 ->
In x4 (add x3 s3) ->
In x1 s4 ->
Subset (add x4 s4) s4.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.eq_chain_test".   fsetdec. Qed.

Lemma test_too_complex : forall x y z r s,
E.eq x y ->
(In x (singleton y) -> r [<=] s) ->
In z r ->
In z s.
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_too_complex".

intros until s; intros Heq H Hr; lapply H; fsetdec.
Qed.

Lemma function_test_1 :
forall (f : t -> t),
forall (g : elt -> elt),
forall (s1 s2 : t),
forall (x1 x2 : elt),
Equal s1 (f s2) ->
E.eq x1 (g (g x2)) ->
In x1 s1 ->
In (g (g x2)) (f s2).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.function_test_1".   fsetdec. Qed.

Lemma function_test_2 :
forall (f : t -> t),
forall (g : elt -> elt),
forall (s1 s2 : t),
forall (x1 x2 : elt),
Equal s1 (f s2) ->
E.eq x1 (g x2) ->
In x1 s1 ->
g x2 = g (g x2) ->
In (g (g x2)) (f s2).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.function_test_2".

intros until 3. intros g_eq. rewrite <- g_eq. fsetdec.
Qed.

Lemma test_baydemir :
forall (f : t -> t),
forall (s : t),
forall (x y : elt),
In x (add y (f s)) ->
~ E.eq x y ->
In x (f s).
Proof. hammer_hook "FSetDecide" "FSetDecide.WDecide_fun.FSetDecideTestCases.test_baydemir".
fsetdec.
Qed.

End FSetDecideTestCases.

End WDecide_fun.

Require Import FSetInterface.

Module WDecide (M:WS) := !WDecide_fun M.E M.
Module Decide := WDecide.

author: lukaszcz

repo: coqhammer-eval