(** * Imp: Simple Imperative Programs *)

(**

As programmers, we constantly define _abstractions_, be it through
full-blown programming languages, domain-specific languages or
APIs. The role of an abstraction is to hide operational details behind
an (hopefully) coherent interface.

In this lecture, we study how such interfaces can be mathematically
described in the Coq theorem prover. By mechanizing the _semantics_ of
an abstraction, we can experiment with its definitions and, if needs
be, actually prove its overall coherence. We can also effectively
implement these abstractions within Coq itself, thus providing a
certified, reference implementation. In this context, proofs replace
unit tests, thus relieving the programmer from implementing and
maintaining somewhat useless code.

 *)

(**

This file is a trimmed down, re-contextualized version of Pierce et
al. eponymous #chapter#
in the Software Foundations textbook.

 *)

(** In this file, we study a _simple imperative programming language_
    called Imp, embodying a tiny core fragment of conventional
    mainstream languages such as C and Java.  Here is a familiar
    mathematical function written in Imp.

     Z ::= X;;
     Y ::= 1;;
     WHILE not (Z = 0) DO
       Y ::= Y * Z;;
       Z ::= Z - 1
     END
*)

(** This file looks at how to define the _syntax_ and _semantics_
    of Imp. *)

Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.omega.Omega.
Require Import Coq.Lists.List.
Require Import Coq.Logic.FunctionalExtensionality.
Import ListNotations.

(* ################################################################# *)
(** * Arithmetic and Boolean Expressions *)

(** We'll present Imp in three parts: first a core language of
    _arithmetic and boolean expressions_, then an extension of these
    expressions with _variables_, and finally a language of _commands_
    including assignment, conditions, sequencing, and loops. *)

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

Module AExp.

(** These two definitions specify the _abstract syntax_ of
    arithmetic and boolean expressions. *)

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

Inductive bexp : Type :=
  | BTrue : bexp
  | BFalse : bexp
  | BEq : aexp -> aexp -> bexp
  | BLe : aexp -> aexp -> bexp
  | BNot : bexp -> bexp
  | BAnd : bexp -> bexp -> bexp.

(** For comparison, here's a conventional BNF (Backus-Naur Form)
    grammar defining the same abstract syntax:

    a ::= nat
        | a + a
        | a - a
        | a * a

    b ::= true
        | false
        | a = a
        | a <= a
        | not b
        | b and b
*)

(** Compared to the Coq version above...

       - The BNF is more informal -- for example, it gives some
         suggestions about the surface syntax of expressions (like the
         fact that the addition operation is written [+] and is an
         infix symbol) while leaving other aspects of lexical analysis
         and parsing (like the relative precedence of [+], [-], and
         [*], the use of parens to explicitly group subexpressions,
         etc.) unspecified.  Some additional information (and human
         intelligence) would be required to turn this description into
         a formal definition, for example when implementing a
         compiler.

         The Coq version consistently omits all this information and
         concentrates on the abstract syntax only.

       - On the other hand, the BNF version is lighter and easier to
         read.  Its informality makes it flexible, which is a huge
         advantage in situations like discussions at the blackboard,
         where conveying general ideas is more important than getting
         every detail nailed down precisely.

         Indeed, there are dozens of BNF-like notations and people
         switch freely among them, usually without bothering to say
         which form of BNF they're using because there is no need to:
         a rough-and-ready informal understanding is all that's
         important.

    It's good to be comfortable with both sorts of notations:
    informal ones for communicating between humans and formal ones for
    carrying out implementations and proofs. *)

(* ================================================================= *)
(** ** Evaluation *)

(** _Evaluating_ an arithmetic expression produces a number. *)

Fixpoint aeval (a : aexp) : nat :=
  match a with
  | ANum n => n
  | APlus a1 a2 => (aeval a1) + (aeval a2)
  | AMinus a1 a2  => (aeval a1) - (aeval a2)
  | AMult a1 a2 => (aeval a1) * (aeval a2)
  end.

Example test_aeval1:
  aeval (APlus (ANum 2) (ANum 2)) = 4.
Proof. reflexivity. Qed.

(** Similarly, evaluating a boolean expression yields a boolean. *)

Fixpoint beval (b : bexp) : bool :=
  match b with
  | BTrue       => true
  | BFalse      => false
  | BEq a1 a2   => beq_nat (aeval a1) (aeval a2)
  | BLe a1 a2   => leb (aeval a1) (aeval a2)
  | BNot b1     => negb (beval b1)
  | BAnd b1 b2  => andb (beval b1) (beval b2)
  end.

(* ================================================================= *)
(** ** Optimization *)

(** We haven't defined very much yet, but we can already get
    some mileage out of the definitions.  Suppose we define a function
    that takes an arithmetic expression and slightly simplifies it,
    changing every occurrence of [0+e] (i.e., [(APlus (ANum 0) e])
    into just [e]. *)

Fixpoint optimize_0plus (a:aexp) : aexp :=
  match a with
  | ANum n =>
      ANum n
  | APlus (ANum 0) e2 =>
      optimize_0plus e2
  | APlus e1 e2 =>
      APlus (optimize_0plus e1) (optimize_0plus e2)
  | AMinus e1 e2 =>
      AMinus (optimize_0plus e1) (optimize_0plus e2)
  | AMult e1 e2 =>
      AMult (optimize_0plus e1) (optimize_0plus e2)
  end.

(** To make sure our optimization is doing the right thing we
    can test it on some examples and see if the output looks OK. *)

Example test_optimize_0plus:
  optimize_0plus (APlus (ANum 2)
                        (APlus (ANum 0)
                               (APlus (ANum 0) (ANum 1))))
  = APlus (ANum 2) (ANum 1).
Proof. reflexivity. Qed.

(** But if we want to be sure the optimization is correct --
    i.e., that evaluating an optimized expression gives the same
    result as the original -- we should prove it. *)

Theorem optimize_0plus_sound: forall a,
  aeval (optimize_0plus a) = aeval a.
Proof.
  intros a. induction a.
  - (* ANum *) reflexivity.
  - (* APlus *) destruct a1.
    + (* a1 = ANum n *) destruct n.
      * (* n = 0 *)  simpl. apply IHa2.
      * (* n <> 0 *) simpl. rewrite IHa2. reflexivity.
    + (* a1 = APlus a1_1 a1_2 *)
      simpl. simpl in IHa1. rewrite IHa1.
      rewrite IHa2. reflexivity.
    + (* a1 = AMinus a1_1 a1_2 *)
      simpl. simpl in IHa1. rewrite IHa1.
      rewrite IHa2. reflexivity.
    + (* a1 = AMult a1_1 a1_2 *)
      simpl. simpl in IHa1. rewrite IHa1.
      rewrite IHa2. reflexivity.
  - (* AMinus *)
    simpl. rewrite IHa1. rewrite IHa2. reflexivity.
  - (* AMult *)
    simpl. rewrite IHa1. rewrite IHa2. reflexivity.  Qed.

(** This proof can still be improved: the first case (for [a = ANum
    n]) is very trivial -- even more trivial than the cases that we
    said simply followed from the IH -- yet we have chosen to write it
    out in full.  It would be better and clearer to drop it and just
    say, at the top, "Most cases are either immediate or direct from
    the IH.  The only interesting case is the one for [APlus]..."  We
    can make the same improvement in our formal proof too.  Here's how
    it looks: *)

Theorem optimize_0plus_sound'': forall a,
  aeval (optimize_0plus a) = aeval a.
Proof.
  intros a.
  induction a;
    (* Most cases follow directly by the IH *)
    try (simpl; rewrite IHa1; rewrite IHa2; reflexivity);
    (* ... or are immediate by definition *)
    try reflexivity.
  (* The interesting case is when a = APlus a1 a2. *)
  - (* APlus *)
    destruct a1; try (simpl; simpl in IHa1; rewrite IHa1;
                      rewrite IHa2; reflexivity).
    + (* a1 = ANum n *) destruct n;
      simpl; rewrite IHa2; reflexivity. Qed.

(** **** Exercise: 3 stars (optimize_0plus_b)  *)
(** Since the [optimize_0plus] transformation doesn't change the value
    of [aexp]s, we should be able to apply it to all the [aexp]s that
    appear in a [bexp] without changing the [bexp]'s value.  Write a
    function which performs that transformation on [bexp]s, and prove
    it is sound. *)

Fixpoint optimize_0plus_b (b : bexp) : bexp :=
(* REPLACE THIS LINE WITH   := _your_definition_ . *)
  match b with
  | BTrue => BTrue
  | BFalse => BFalse
  | BEq a1 a2   => BEq(optimize_0plus a1) (optimize_0plus a2)
  | BLe a1 a2   => BLe (optimize_0plus a1) (optimize_0plus a2)
  | BNot b1     => BNot (optimize_0plus_b b1)
  | BAnd b1 b2  => BAnd (optimize_0plus_b b1) (optimize_0plus_b b2)
  end.

(**
[[Optimize_0plus_b sound]]
*)
Theorem optimize_0plus_b_sound : forall b,
    beval (optimize_0plus_b b) = beval b.
Proof.
  intro b.
  induction b;
    try reflexivity;
  (* b1 = b2 *)
    try
     (simpl; rewrite optimize_0plus_sound; rewrite optimize_0plus_sound;
      reflexivity).
  - simpl. rewrite IHb. reflexivity.
  - simpl. rewrite IHb1; rewrite IHb2; reflexivity.
Qed.

    (** **** Exercise: 4 stars, optional (optimizer)  *)
(** _Design exercise_: The optimization implemented by our
    [optimize_0plus] function is only one of many possible
    optimizations on arithmetic and boolean expressions.  Write a more
    sophisticated optimizer and prove it correct. *)

(* ################################################################# *)
(** * Evaluation as a Relation *)

(** We have presented [aeval] and [beval] as functions defined by
    [Fixpoint]s.  Another way to think about evaluation -- one that we
    will see is often more flexible -- is as a _relation_ between
    expressions and their values.  This leads naturally to [Inductive]
    definitions like the following one for arithmetic expressions... *)

Module aevalR_first_try.

Inductive aevalR : aexp -> nat -> Prop :=
  | E_ANum  : forall (n: nat),
      aevalR (ANum n) n
  | E_APlus : forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (APlus e1 e2) (n1 + n2)
  | E_AMinus: forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (AMinus e1 e2) (n1 - n2)
  | E_AMult : forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (AMult e1 e2) (n1 * n2).

(** As is often the case with relations, we'll find it
    convenient to define infix notation for [aevalR].  We'll write [e
    \\ n] to mean that arithmetic expression [e] evaluates to value
    [n].  (This notation is one place where the limitation to ASCII
    symbols becomes a little bothersome.  The standard notation for
    the evaluation relation is a double down-arrow.  We'll typeset it
    like this in the HTML version of the notes and use a double slash
    as the closest approximation in [.v] files.)  *)

Notation "e '⇓' n"
         := (aevalR e n)
            (at level 50, left associativity)
         : type_scope.

End aevalR_first_try.

(** In fact, Coq provides a way to use this notation in the definition
    of [aevalR] itself.  This avoids situations where we're working on
    a proof involving statements in the form [e \\ n] but we have to
    refer back to a definition written using the form [aevalR e n].

    We do this by first "reserving" the notation, then giving the
    definition together with a declaration of what the notation
    means. *)

Reserved Notation "e '⇓' n" (at level 50, left associativity).

Inductive aevalR : aexp -> nat -> Prop :=
  | E_ANum : forall (n:nat),
  (*----------------*)
      (ANum n) ⇓ n
  | E_APlus : forall (e1 e2: aexp) (n1 n2 : nat),
      e1 ⇓ n1 ->
      e2 ⇓ n2 ->
  (*--------------------------------*)
      (APlus e1 e2) ⇓ (n1 + n2)
  | E_AMinus : forall (e1 e2: aexp) (n1 n2 : nat),
      e1 ⇓ n1 ->
      e2 ⇓ n2 ->
  (*--------------------------------*)
      (AMinus e1 e2) ⇓ (n1 - n2)
  | E_AMult :  forall (e1 e2: aexp) (n1 n2 : nat),
      e1 ⇓ n1 ->
      e2 ⇓ n2 ->
  (*--------------------------------*)
      (AMult e1 e2) ⇓ (n1 * n2)

  where "e '⇓' n" := (aevalR e n) : type_scope.

(* ================================================================= *)
(** ** Inference Rule Notation *)

(** In informal discussions, it is convenient to write the rules for
    [aevalR] and similar relations in the more readable graphical form
    of _inference rules_, where the premises above the line justify
    the conclusion below the line (we have already seen them in the
    Prop chapter). *)

(** For example, the constructor [E_APlus]...

      | E_APlus : forall (e1 e2: aexp) (n1 n2: nat),
          aevalR e1 n1 ->
          aevalR e2 n2 ->
      (*--------------------------------*)
          aevalR (APlus e1 e2) (n1 + n2)

    ...would be written like this as an inference rule:

                               e1 ⇓ n1
                               e2 ⇓ n2
                         --------------------                         (E_APlus)
                         APlus e1 e2 ⇓ n1+n2
*)

(** Formally, there is nothing deep about inference rules: they
    are just implications.  You can read the rule name on the right as
    the name of the constructor and read each of the linebreaks
    between the premises above the line and the line itself as [->].
    All the variables mentioned in the rule ([e1], [n1], etc.) are
    implicitly bound by universal quantifiers at the beginning. (Such
    variables are often called _metavariables_ to distinguish them
    from the variables of the language we are defining.  At the
    moment, our arithmetic expressions don't include variables, but
    we'll soon be adding them.)  The whole collection of rules is
    understood as being wrapped in an [Inductive] declaration.  In
    informal prose, this is either elided or else indicated by saying
    something like "Let [aevalR] be the smallest relation closed under
    the following rules...". *)

(** For example, [⇓] is the smallest relation closed under these
    rules:

                             -----------                               (E_ANum)
                             ANum n ⇓ n

                               e1 ⇓ n1
                               e2 ⇓ n2
                         --------------------                         (E_APlus)
                         APlus e1 e2 ⇓ n1+n2

                               e1 ⇓ n1
                               e2 ⇓ n2
                        ---------------------                        (E_AMinus)
                        AMinus e1 e2 ⇓ n1-n2

                               e1 ⇓ n1
                               e2 ⇓ n2
                         --------------------                         (E_AMult)
                         AMult e1 e2 ⇓ n1*n2
*)

(* ================================================================= *)
(** ** Equivalence of the Definitions *)

(** It is straightforward to prove that the relational and functional
    definitions of evaluation agree, for all arithmetic expressions... *)

Theorem aeval_iff_aevalR : forall a n,
  (a ⇓ n) <-> aeval a = n.
Proof.
 split.
 - (* -> *)
   intros H.
   induction H; simpl.
   + (* E_ANum *)
     reflexivity.
   + (* E_APlus *)
     rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
   + (* E_AMinus *)
     rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
   + (* E_AMult *)
     rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
 - (* <- *)
   generalize dependent n.
   induction a;
      simpl; intros; subst.
   + (* ANum *)
     apply E_ANum.
   + (* APlus *)
     apply E_APlus.
      apply IHa1. reflexivity.
      apply IHa2. reflexivity.
   + (* AMinus *)
     apply E_AMinus.
      apply IHa1. reflexivity.
      apply IHa2. reflexivity.
   + (* AMult *)
     apply E_AMult.
      apply IHa1. reflexivity.
      apply IHa2. reflexivity.
Qed.

(** We can make the proof quite a bit shorter by making more
    use of tacticals... *)

Theorem aeval_iff_aevalR' : forall a n,
  a ⇓ n <-> aeval a = n.
Proof.
  split.
  - (* -> *)
    intros H; induction H; subst; reflexivity.
  - (* <- *)
    generalize dependent n.
    induction a; simpl; intros; subst; constructor;
       try apply IHa1; try apply IHa2; reflexivity.
Qed.

(** **** Exercise: 3 stars  (bevalR)  *)
(** Write a relation [bevalR] in the same style as
    [aevalR], and prove that it is equivalent to [beval].*)

Inductive bevalR : bexp -> bool -> Prop :=
  | E_BTrue :
  (*----------------*)
      bevalR BTrue true
  | E_BFalse :
  (*----------------*)
      bevalR BFalse false
  | E_BEq : forall (e1 e2: aexp) (n1 n2 : nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
  (*--------------------------------*)
      bevalR (BEq e1 e2) (beq_nat n1 n2)
  | E_BLe : forall (e1 e2: aexp) (n1 n2 : nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
  (*--------------------------------*)
      bevalR (BLe e1 e2) (leb n1 n2)
  | E_BNot :  forall (b: bexp) (b': bool),
      bevalR b b' ->
  (*--------------------------------*)
      bevalR (BNot b) (negb b')
  | E_BAnd : forall (b1 b2: bexp) (b1' b2': bool),
      bevalR b1 b1' ->
      bevalR b2 b2' ->
  (*--------------------------------*)
      bevalR (BAnd b1 b2) (andb b1' b2')
.

End AExp.

(* ================================================================= *)
(** ** Computational vs. Relational Definitions *)

(** For the definitions of evaluation for arithmetic and boolean
    expressions, the choice of whether to use functional or relational
    definitions is mainly a matter of taste.  In general, Coq has
    somewhat better support for working with relations.  On the other
    hand, in some sense function definitions carry more information,
    because functions are by definition deterministic and defined on
    all arguments; for a relation we have to show these properties
    explicitly if we need them.  Functions also take advantage of
    Coq's computation mechanism.

    However, there are circumstances where relational definitions of
    evaluation are preferable to functional ones.  *)

Module aevalR_division.

(** For example, suppose that we wanted to extend the arithmetic
    operations by considering also a division operation:*)

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp
  | ADiv : aexp -> aexp -> aexp.   (* <--- new *)

(** Extending the definition of [aeval] to handle this new operation
    would not be straightforward (what should we return as the result
    of [ADiv (ANum 5) (ANum 0)]?).  But extending [aevalR] is
    straightforward. *)

Reserved Notation "e '⇓' n"
                  (at level 50, left associativity).

Inductive aevalR : aexp -> nat -> Prop :=
  | E_ANum : forall (n:nat),

  (*----------------*)
      (ANum n) ⇓ n

  | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (APlus a1 a2) ⇓ (n1 + n2)

  | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (AMinus a1 a2) ⇓ (n1 - n2)

  | E_AMult :  forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (AMult a1 a2) ⇓ (n1 * n2)

  | E_ADiv :  forall (a1 a2: aexp) (n1 n2 n3: nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
      n2 > 0 ->
      mult n2 n3 = n1 ->
  (*------------------------------------------*)
      (ADiv a1 a2) ⇓ n3

where "a '⇓' n" := (aevalR a n) : type_scope.

End aevalR_division.

Module aevalR_extended.

(* ----------------------------------------------------------------- *)
(** *** Adding Nondeterminism *)

(** Suppose, instead, that we want to extend the arithmetic operations
    by a nondeterministic number generator [any] that, when evaluated,
    may yield any number.  (Note that this is not the same as making a
    _probabilistic_ choice among all possible numbers -- we're not
    specifying any particular distribution of results, but just saying
    what results are _possible_.) *)

Reserved Notation "e '⇓' n" (at level 50, left associativity).

Inductive aexp : Type :=
  | AAny  : aexp                   (* <--- NEW *)
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

(** Again, extending [aeval] would be tricky, since now evaluation is
    _not_ a deterministic function from expressions to numbers, but
    extending [aevalR] is no problem: *)

Inductive aevalR : aexp -> nat -> Prop :=
  | E_Any : forall (n:nat),

  (*-----------------------------*)
      AAny ⇓ n                 (* <--- new *)

  | E_ANum : forall (n:nat),

  (*-----------------------------*)
      (ANum n) ⇓ n

  | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (APlus a1 a2) ⇓ (n1 + n2)
  | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (AMinus a1 a2) ⇓ (n1 - n2)

  | E_AMult :  forall (a1 a2: aexp) (n1 n2 : nat),

      a1 ⇓ n1 ->
      a2 ⇓ n2 ->
  (*-----------------------------*)
      (AMult a1 a2) ⇓ (n1 * n2)

where "a '⇓' n" := (aevalR a n) : type_scope.

End aevalR_extended.

(* ################################################################# *)
(** * Interlude: Total Maps *)

(** Maps (or dictionaries) are ubiquitous data structures, both in
    software construction generally and in the theory of programming
    languages in particular.

    Here, we'll define _total_ maps, which include a "default" element to be
    returned when a key being looked up doesn't exist. *)

(** * Identifiers *)

(** First, we need a type for the keys that we use to index into our
    maps.  For this purpose, we define a new inductive datatype [id]
    to serve as the "keys" of our partial maps. *)

Inductive id : Type :=
  | Id : nat -> id.

(** Internally, an [id] is just a number.  Introducing a separate type
    by wrapping each nat with the tag [Id] makes definitions more
    readable and gives us the flexibility to change representations
    later if we wish.

    We'll also need an equality test for [id]s: *)

Definition beq_id x1 x2 :=
  match x1, x2 with
  | Id n1, Id n2 => beq_nat n1 n2
  end.

(** **** Exercise: 1 star (beq_id_refl)  *)

Theorem beq_id_refl : forall x, true = beq_id x x.
  Proof.
    intros [x]. unfold beq_id. apply beq_nat_refl.
Qed.
    (** The following useful property of [beq_id] follows from an
    analogous lemma about numbers: *)

Theorem beq_id_true_iff : forall id1 id2 : id,
  beq_id id1 id2 = true <-> id1 = id2.
Proof.
   intros [n1] [n2].
   unfold beq_id.
   rewrite beq_nat_true_iff.
   split.
   - (* -> *) intros H. rewrite H. reflexivity.
   - (* <- *) intros H. inversion H. reflexivity.
Qed.

(** Similarly: *)

Theorem beq_id_false_iff : forall x y : id,
  beq_id x y = false
  <-> x <> y.
Proof.
  intros x y. rewrite <- beq_id_true_iff.
  rewrite not_true_iff_false. reflexivity.
Qed.

(** This useful variant follows just by rewriting: *)

Theorem false_beq_id : forall x y : id,
   x <> y
   -> beq_id x y = false.
Proof.
  intros x y. rewrite beq_id_false_iff.
  intros H. apply H.
Qed.

(* ################################################################# *)
(** * Total Maps *)

(** We define a type of _total maps_ that return a default value when
    we look up a key that is not present in the map. *)

Definition total_map (A:Type) := id -> A.

(** Intuitively, a total map over an element type [A] _is_ just a
    function that can be used to look up [id]s, yielding [A]s.

    The function [t_empty] yields an empty total map, given a default
    element; this map always returns the default element when applied
    to any id. *)

Definition t_empty {A:Type} (v : A) : total_map A :=
  (fun _ => v).

(** More interesting is the [update] function, which takes a map [m],
    a key [x], and a value [v] and returns a new map that takes [x] to
    [v] and takes every other key to whatever [m] does. *)

Definition t_update {A:Type} (m : total_map A)
                    (x : id) (v : A) :=
  fun x' => if beq_id x x' then v else m x'.

(** This definition is a nice example of higher-order programming.
    The [t_update] function takes a _function_ [m] and yields a new
    function [fun x' => ...] that behaves like the desired map.

    For example, we can build a map taking [id]s to [bool]s, where [Id
    3] is mapped to [true] and every other key is mapped to [false],
    like this: *)

Definition examplemap :=
  t_update (t_update (t_empty false) (Id 1) false)
           (Id 3) true.

(** This completes the definition of total maps.  Note that we don't
    need to define a [find] operation because it is just function
    application! *)

Example update_example1 : examplemap (Id 0) = false.
Proof. reflexivity. Qed.

Example update_example2 : examplemap (Id 1) = false.
Proof. reflexivity. Qed.

Example update_example3 : examplemap (Id 2) = false.
Proof. reflexivity. Qed.

Example update_example4 : examplemap (Id 3) = true.
Proof. reflexivity. Qed.

Eval compute in examplemap (Id 8).
(** We'll need several fundamental facts about how they behave.  Even
    if you don't work the following exercises, make sure you
    thoroughly understand the statements of the lemmas!  (Some of the
    proofs require the functional extensionality axiom.) *)

(** **** Exercise: 1 star, optional (t_apply_empty)  *)
(** First, the empty map returns its default element for all keys*)

Lemma t_apply_empty:  forall A x v, @t_empty A v x = v.
Proof. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (t_update_eq)  *)
(** Next, if we update a map [m] at a key [x] with a new value [v]
    and then look up [x] in the map resulting from the [update], we
    get back [v]:
*)
Lemma t_update_eq : forall A (m: total_map A) x v,
      (t_update m x v) x = v.
Proof.
  intros. unfold t_update. rewrite <- beq_id_refl. reflexivity. Qed.

  (** **** Exercise: 2 stars, optional (t_update_neq)  *)
(** On the other hand, if we update a map [m] at a key [x1] and then
    look up a _different_ key [x2] in the resulting map, we get the
    same result that [m] would have given:
*)
Theorem t_update_neq : forall (X:Type) v x1 x2
                           (m : total_map X),
    x1 <> x2 ->
    (t_update m x1 v) x2 = m x2.
Proof.
  intros. unfold t_update. rewrite false_beq_id.
  - reflexivity.
  - assumption.
Qed.

(** **** Exercise: 2 stars, optional (t_update_shadow)  *)
(** If we update a map [m] at a key [x] with a value [v1] and then
    update again with the same key [x] and another value [v2], the
    resulting map behaves the same (gives the same result when applied
    to any key) as the simpler map obtained by performing just
    the second [update] on [m]:
*)
Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x,
    t_update (t_update m x v1) x v2
    = t_update m x v2.
Proof.
  intros. unfold t_update.
  apply functional_extensionality.
  intro. case (beq_id x x0); reflexivity.
Qed.

(** For the final two lemmas, we begin by proving a fundamental
    _reflection lemma_ relating the equality proposition on [id]s with
    the boolean function [beq_id]. *)

(** **** Exercise: 2 stars (beq_idP)  *)
(** Prove the following: *)

Lemma beq_idP : forall x y, reflect (x = y) (beq_id x y).
Proof.
  intros. SearchAbout "reflect".
  apply iff_reflect.
  split.
  - apply beq_id_true_iff.
  - apply beq_id_true_iff.
Qed.

  (** Now, given [id]s [x1] and [x2], we can use the [destruct (beq_idP
    x1 x2)] to simultaneously perform case analysis on the result of
    [beq_id x1 x2] and generate hypotheses about the equality (in the
    sense of [=]) of [x1] and [x2]. *)

(** **** Exercise: 2 stars (t_update_same)  *)
(** Use [beq_idP] to prove the following theorem, which states that if
    we update a map to assign key [x] the same value as it already has
    in [m], then the result is equal to [m]:
*)
Theorem t_update_same : forall X x (m : total_map X),
    t_update m x (m x) = m.
Proof.
  intros. unfold t_update.
  apply functional_extensionality.
  intro. destruct (beq_idP x x0).
  - rewrite e. reflexivity.
  - reflexivity.
Qed.
  (** **** Exercise: 3 stars, recommended (t_update_permute)  *)
(** Use [beq_idP] to prove one final property of the [update]
    function: If we update a map [m] at two distinct keys, it doesn't
    matter in which order we do the updates.
*)
 Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2
                             (m : total_map X),
    x2 <> x1 ->
      (t_update (t_update m x2 v2) x1 v1)
    = (t_update (t_update m x1 v1) x2 v2).
Proof.
  intros. unfold t_update.
  apply functional_extensionality.
  intro. destruct (beq_idP x1 x).
  - rewrite <- e. destruct (beq_idP x2 x1).
    (* goal: False then destruct the contradictory hypothesis *)
    + subst. exfalso. destruct H. reflexivity.
    + reflexivity.
  - reflexivity.
Qed.
    (* ################################################################# *)
(** * Expressions With Variables *)

(** Let's turn our attention back to defining Imp.  The next thing we
    need to do is to enrich our arithmetic and boolean expressions
    with variables.  To keep things simple, we'll assume that all
    variables are global and that they only hold numbers. *)

(* ================================================================= *)
(** ** States *)

(** Since we'll want to look variables up to find out their current
    values, we'll reuse the type [id] for the type of variables in
    Imp.

    A _machine state_ (or just _state_) represents the current values
    of _all_ variables at some point in the execution of a program. *)

(** For simplicity, we assume that the state is defined for
    _all_ variables, even though any given program is only going to
    mention a finite number of them.  The state captures all of the
    information stored in memory.  For Imp programs, because each
    variable stores a natural number, we can represent the state as a
    mapping from identifiers to [nat].  For more complex programming
    languages, the state might have more structure. *)

Definition state := total_map nat.

Definition empty_state : state :=
  t_empty 0.

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

(** We can add variables to the arithmetic expressions we had before by
    simply adding one more constructor: *)

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | AId : id -> aexp                (* <----- NEW *)
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

(** Defining a few variable names as notational shorthands will make
    examples easier to read: *)

Definition X : id := Id 0.
Definition Y : id := Id 1.
Definition Z : id := Id 2.

(** The definition of [bexp]s is unchanged (except for using the new
    [aexp]s): *)

Inductive bexp : Type :=
  | BTrue : bexp
  | BFalse : bexp
  | BEq : aexp -> aexp -> bexp
  | BLe : aexp -> aexp -> bexp
  | BNot : bexp -> bexp
  | BAnd : bexp -> bexp -> bexp.

(* ================================================================= *)
(** ** Evaluation  *)

(** The arith and boolean evaluators are extended to handle
    variables in the obvious way, taking a state as an extra
    argument: *)

Fixpoint aeval (st : state) (a : aexp) : nat :=
  match a with
  | ANum n => n
  | AId x => st x                                (* <----- NEW *)
  | APlus a1 a2 => (aeval st a1) + (aeval st a2)
  | AMinus a1 a2  => (aeval st a1) - (aeval st a2)
  | AMult a1 a2 => (aeval st a1) * (aeval st a2)
  end.

Fixpoint beval (st : state) (b : bexp) : bool :=
  match b with
  | BTrue       => true
  | BFalse      => false
  | BEq a1 a2   => beq_nat (aeval st a1) (aeval st a2)
  | BLe a1 a2   => leb (aeval st a1) (aeval st a2)
  | BNot b1     => negb (beval st b1)
  | BAnd b1 b2  => andb (beval st b1) (beval st b2)
  end.

Example aexp1 :
  aeval (t_update empty_state X 5)
        (APlus (ANum 3) (AMult (AId X) (ANum 2)))
  = 13.
Proof. reflexivity. Qed.

Example bexp1 :
  beval (t_update empty_state X 5)
        (BAnd BTrue (BNot (BLe (AId X) (ANum 4))))
  = true.
Proof. reflexivity. Qed.

(* ################################################################# *)
(** * Commands *)

(** Now we are ready define the syntax and behavior of Imp
    _commands_ (sometimes called _statements_). *)

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

(** Informally, commands [c] are described by the following BNF
    grammar.  (We choose this slightly awkward concrete syntax for the
    sake of being able to define Imp syntax using Coq's Notation
    mechanism.  In particular, we use [IFB] to avoid conflicting with
    the [if] notation from the standard library.)

     c ::= SKIP | x ::= a | c ;; c | IFB b THEN c ELSE c FI
         | WHILE b DO c END
*)
(**
    For example, here's factorial in Imp:

     Z ::= X;;
     Y ::= 1;;
     WHILE not (Z = 0) DO
       Y ::= Y * Z;;
       Z ::= Z - 1
     END

   When this command terminates, the variable [Y] will contain the
   factorial of the initial value of [X]. *)

(** Here is the formal definition of the abstract syntax of
    commands: *)

Inductive com : Type :=
  | CSkip : com
  | CAss : id -> aexp -> com
  | CSeq : com -> com -> com
  | CIf : bexp -> com -> com -> com
  | CWhile : bexp -> com -> com.

(** As usual, we can use a few [Notation] declarations to make things
    more readable.  To avoid conflicts with Coq's built-in notations,
    we keep this light -- in particular, we don't introduce any
    notations for [aexps] and [bexps] to avoid confusion with the
    numeric and boolean operators we've already defined. *)

Notation "'SKIP'" :=
  CSkip.
Notation "x '::=' a" :=
  (CAss x a) (at level 60).
Notation "c1 ;; c2" :=
  (CSeq c1 c2) (at level 80, right associativity).
Notation "'WHILE' b 'DO' c 'END'" :=
  (CWhile b c) (at level 80, right associativity).
Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" :=
  (CIf c1 c2 c3) (at level 80, right associativity).

(** For example, here is the factorial function again, written as a
    formal definition to Coq: *)

Definition fact_in_coq : com :=
  Z ::= AId X;;
  Y ::= ANum 1;;
  WHILE BNot (BEq (AId Z) (ANum 0)) DO
    Y ::= AMult (AId Y) (AId Z);;
    Z ::= AMinus (AId Z) (ANum 1)
  END.

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

(** Assignment: *)

Definition plus2 : com :=
  X ::= (APlus (AId X) (ANum 2)).

Definition XtimesYinZ : com :=
  Z ::= (AMult (AId X) (AId Y)).

Definition subtract_slowly_body : com :=
  Z ::= AMinus (AId Z) (ANum 1) ;;
  X ::= AMinus (AId X) (ANum 1).

(* ----------------------------------------------------------------- *)
(** *** Loops *)

Definition subtract_slowly : com :=
  WHILE BNot (BEq (AId X) (ANum 0)) DO
    subtract_slowly_body
  END.

Definition subtract_3_from_5_slowly : com :=
  X ::= ANum 3 ;;
  Z ::= ANum 5 ;;
  subtract_slowly.

(* ----------------------------------------------------------------- *)
(** *** An infinite loop: *)

Definition loop : com :=
  WHILE BTrue DO
    SKIP
  END.

(* ################################################################# *)
(** * Evaluation *)

(** Next we need to define what it means to evaluate an Imp command.
    The fact that [WHILE] loops don't necessarily terminate makes defining
    an evaluation function tricky... *)

(* ================================================================= *)
(** ** Evaluation as a Function (Failed Attempt) *)

(** Here's an attempt at defining an evaluation function for commands,
    omitting the [WHILE] case. *)

Fixpoint ceval_fun_no_while (st : state) (c : com)
                          : state :=
  match c with
    | SKIP =>
        st
    | x ::= a1 =>
        t_update st x (aeval st a1)
    | c1 ;; c2 =>
        let st' := ceval_fun_no_while st c1 in
        ceval_fun_no_while st' c2
    | IFB b THEN c1 ELSE c2 FI =>
        if (beval st b)
          then ceval_fun_no_while st c1
          else ceval_fun_no_while st c2
    | WHILE b DO c END =>
        st  (* bogus *)
  end.

(** In a traditional functional programming language like OCaml or
    Haskell we could add the [WHILE] case as follows:

  Fixpoint ceval_fun (st : state) (c : com) : state :=
    match c with
      ...
      | WHILE b DO c END =>
          if (beval st b)
            then ceval_fun st (c; WHILE b DO c END)
            else st
    end.

    Coq doesn't accept such a definition ("Error: Cannot guess
    decreasing argument of fix") because the function we want to
    define is not guaranteed to terminate. Indeed, it _doesn't_ always
    terminate: for example, the full version of the [ceval_fun]
    function applied to the [loop] program above would never
    terminate. Since Coq is not just a functional programming
    language, but also a consistent logic, any potentially
    non-terminating function needs to be rejected. Here is
    an (invalid!) Coq program showing what would go wrong if Coq
    allowed non-terminating recursive functions:

         Fixpoint loop_false (n : nat) : False := loop_false n.

    That is, propositions like [False] would become provable
    (e.g., [loop_false 0] would be a proof of [False]), which
    would be a disaster for Coq's logical consistency.

    Thus, because it doesn't terminate on all inputs, the full version
    of [ceval_fun] cannot be written in Coq -- at least not without
    additional tricks. *)

(* ================================================================= *)
(** ** Evaluation as a Relation *)

(** Here's a better way: define [ceval] as a _relation_ rather than a
    _function_ -- i.e., define it in [Prop] instead of [Type], as we
    did for [aevalR] above. *)

(** This is an important change.  Besides freeing us from the awkward
    workarounds that would be needed to define evaluation as a
    function, it gives us a lot more flexibility in the definition.
    For example, if we add nondeterministic features like [any] to the
    language, we want the definition of evaluation to be
    nondeterministic -- i.e., not only will it not be total, it will
    not even be a function! *)
(** We'll use the notation [c / st ⇓ st'] for our [ceval] relation:
    [c / st ⇓ st'] means that executing program [c] in a starting
    state [st] results in an ending state [st'].  This can be
    pronounced "[c] takes state [st] to [st']". *)

(* ----------------------------------------------------------------- *)
(** *** Operational Semantics *)
(** Here is an informal definition of evaluation, presented as inference
    rules for the sake of readability:

                           ----------------                            (E_Skip)
                           SKIP / st ⇓ st

                           aeval st a1 = n
                   --------------------------------                     (E_Ass)
                   x := a1 / st ⇓ (t_update st x n)

                           c1 / st ⇓ st'
                          c2 / st' ⇓ st''
                         -------------------                            (E_Seq)
                         c1;;c2 / st ⇓ st''

                          beval st b1 = true
                           c1 / st ⇓ st'
                -------------------------------------                (E_IfTrue)
                IF b1 THEN c1 ELSE c2 FI / st ⇓ st'

                         beval st b1 = false
                           c2 / st ⇓ st'
                -------------------------------------               (E_IfFalse)
                IF b1 THEN c1 ELSE c2 FI / st ⇓ st'

                         beval st b = false
                    ------------------------------                 (E_WhileEnd)
                    WHILE b DO c END / st ⇓ st

                          beval st b = true
                           c / st ⇓ st'
                  WHILE b DO c END / st' ⇓ st''
                  ---------------------------------               (E_WhileLoop)
                    WHILE b DO c END / st ⇓ st''
*)

(** Here is the formal definition.  Make sure you understand
    how it corresponds to the inference rules. *)

Reserved Notation "c1 '/' st '⇓' st'"
                  (at level 40, st at level 39).

Inductive ceval : com -> state -> state -> Prop :=
  | E_Skip : forall st,

  (*--------------------------------------*)
      SKIP / st ⇓ st
  | E_Ass  : forall st a1 n x,

      aeval st a1 = n ->
  (*--------------------------------------*)
      (x ::= a1) / st ⇓ (t_update st x n)
  | E_Seq : forall c1 c2 st st' st'',

      c1 / st  ⇓ st' ->
      c2 / st' ⇓ st'' ->
  (*--------------------------------------*)
      (c1 ;; c2) / st ⇓ st''
  | E_IfTrue : forall st st' b c1 c2,

      beval st b = true ->
      c1 / st ⇓ st' ->
  (*--------------------------------------*)
      (IFB b THEN c1 ELSE c2 FI) / st ⇓ st'
  | E_IfFalse : forall st st' b c1 c2,

      beval st b = false ->
      c2 / st ⇓ st' ->
  (*--------------------------------------*)
      (IFB b THEN c1 ELSE c2 FI) / st ⇓ st'
  | E_WhileEnd : forall b st c,

      beval st b = false ->
  (*--------------------------------------*)
      (WHILE b DO c END) / st ⇓ st
  | E_WhileLoop : forall st st' st'' b c,

      beval st b = true ->
      c / st ⇓ st' ->
      (WHILE b DO c END) / st' ⇓ st'' ->
  (*--------------------------------------*)
      (WHILE b DO c END) / st ⇓ st''

  where "c1 '/' st '⇓' st'" := (ceval c1 st st').

(** The cost of defining evaluation as a relation instead of a
    function is that we now need to construct _proofs_ that some
    program evaluates to some result state, rather than just letting
    Coq's computation mechanism do it for us. *)

Example ceval_example1:
    (X ::= ANum 2;;
     IFB BLe (AId X) (ANum 1)
       THEN Y ::= ANum 3
       ELSE Z ::= ANum 4
     FI)
   / empty_state
   ⇓ (t_update (t_update empty_state X 2) Z 4).
Proof.
  (* We must supply the intermediate state *)
  apply E_Seq with (t_update empty_state X 2).
  - (* assignment command *)
    apply E_Ass. reflexivity.
  - (* if command *)
    apply E_IfFalse.
      reflexivity.
      apply E_Ass. reflexivity.  Qed.

(** **** Exercise: 2 stars (ceval_example2)  *)

(** Show that the following derivation is inhabited:*)
Example ceval_example2:
    (X ::= ANum 0;; Y ::= ANum 1;; Z ::= ANum 2) / empty_state ⇓
    (t_update (t_update (t_update empty_state X 0) Y 1) Z 2).
Proof.
  apply E_Seq with (t_update empty_state X 0).
  - apply E_Ass. reflexivity.
  - apply E_Seq with (t_update (t_update empty_state X 0) Y 1).
    + apply E_Ass. reflexivity.
    + apply E_Ass. reflexivity.
Qed.

(** **** Exercise: 3 stars, advanced (pup_to_n)  *)
(** Write an Imp program that sums the numbers from [1] to
   [X] (inclusive: [1 + 2 + ... + X]) in the variable [Y].
   Prove that this program executes as intended for [X] = [2]
   (the latter is trickier than you might expect).

*)

Definition pup_to_n : com  :=
  Y ::= ANum 0 ;;
  WHILE BNot (BEq (AId X) (ANum 0)) DO
   Y ::= APlus (AId Y)  (AId X) ;;
   X ::= AMinus (AId X) (ANum 1)
  END.

Theorem pup_to_2_ceval :
  pup_to_n / (t_update empty_state X 2) ⇓
    t_update (t_update (t_update (t_update (t_update (t_update empty_state
      X 2) Y 0) Y 2) X 1) Y 3) X 0.
Proof.
  apply E_Seq with (t_update (t_update empty_state X 2) Y 0).
  - apply E_Ass. reflexivity.
  - apply E_WhileLoop with (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1).
    + reflexivity.
    + apply E_Seq with (t_update (t_update (t_update empty_state X 2) Y 0) Y 2).
      * apply E_Ass. reflexivity.
      * apply E_Ass. reflexivity.
    + apply E_WhileLoop with (t_update (t_update (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1) Y 3) X 0).
      * reflexivity.
      * {apply E_Seq with (t_update (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1) Y 3).
          -apply E_Ass.
            reflexivity.
          - apply E_Ass.
            reflexivity.
        }
      * apply E_WhileEnd. reflexivity.
Qed.

(* ================================================================= *)
(** ** Determinism of Evaluation *)

(** Changing from a computational to a relational definition of
    evaluation is a good move because it allows us to escape from the
    artificial requirement that evaluation should be a total function.
    But it also raises a question: Is the second definition of
    evaluation really a partial function?  Or is it possible that,
    beginning from the same state [st], we could evaluate some command
    [c] in different ways to reach two different output states [st']
    and [st'']?

    In fact, this cannot happen: [ceval] _is_ a partial function: *)

Theorem ceval_deterministic: forall c st st1 st2,
     c / st ⇓ st1  ->
     c / st ⇓ st2 ->
     st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2.
  induction E1;
           intros st2 E2; inversion E2; subst.
  - (* E_Skip *) reflexivity.
  - (* E_Ass *) reflexivity.
  - (* E_Seq *)
    assert (st' = st'0) as EQ1.
    { (* Proof of assertion *) apply IHE1_1; assumption. }
    subst st'0.
    apply IHE1_2. assumption.
  - (* E_IfTrue, b1 evaluates to true *)
      apply IHE1. assumption.
  - (* E_IfTrue,  b1 evaluates to false (contradiction) *)
      rewrite H in H5. inversion H5.
  - (* E_IfFalse, b1 evaluates to true (contradiction) *)
    rewrite H in H5. inversion H5.
  - (* E_IfFalse, b1 evaluates to false *)
      apply IHE1. assumption.
  - (* E_WhileEnd, b1 evaluates to false *)
    reflexivity.
  - (* E_WhileEnd, b1 evaluates to true (contradiction) *)
    rewrite H in H2. inversion H2.
  - (* E_WhileLoop, b1 evaluates to false (contradiction) *)
    rewrite H in H4. inversion H4.
  - (* E_WhileLoop, b1 evaluates to true *)
      assert (st' = st'0) as EQ1.
      { (* Proof of assertion *) apply IHE1_1; assumption. }
      subst st'0.
      apply IHE1_2. assumption.  Qed.

(* ################################################################# *)
(** * Reasoning About Imp Programs *)

(** We'll get much deeper into systematic techniques for reasoning
    about Imp programs in the following lectures, but we can do quite
    a bit just working with the bare definitions. *)

(** This section explores some examples. *)

Theorem plus2_spec : forall st n st',
  st X = n ->
  plus2 / st ⇓ st' ->
  st' X = n + 2.
Proof.
  intros st n st' HX Heval.

  (** Inverting [Heval] essentially forces Coq to expand one step of
      the [ceval] computation -- in this case revealing that [st']
      must be [st] extended with the new value of [X], since [plus2]
      is an assignment *)

  inversion Heval. subst. clear Heval. simpl.
  apply t_update_eq.  Qed.

(** **** Exercise: 3 stars, recommended (XtimesYinZ_spec)  *)
(** State and prove a specification of [XtimesYinZ]. *)
Print plus2.
Print XtimesYinZ.
Theorem XtimesYinZ_spec : forall st st' n m,
    st X = n ->
    st Y = m ->
    ceval XtimesYinZ st st' ->
    st' Z = n*m.
Proof.
  intros st st' n m Hx Hy Heval.
  inversion Heval. subst. clear Heval. apply t_update_eq.
Qed.

(** **** Exercise: 3 stars, recommended (loop_never_stops)  *)

(** By induction on the assumed derivation showing that [loopdef]
    terminates, prove that the program [loop] never terminates.  Most
    of the cases are immediately contradictory (and so can be solved
    in one step with [inversion]).
*)
Lemma loop_stops : forall st st',
    ceval loop st st'.
Proof.
Admitted.
Theorem loop_never_stops : forall st st',
    ~(loop / st ⇓ st').
Proof.
  intros. unfold not.
  destruct loop.
  intro. inversion H.
Admitted.

(** **** Exercise: 3 stars (no_whilesR)  *)
(** Consider the definition of the [no_whiles] boolean predicate below: *)

Fixpoint no_whiles (c : com) : bool :=
  match c with
  | SKIP =>
      true
  | _ ::= _ =>
      true
  | c1 ;; c2 =>
      andb (no_whiles c1) (no_whiles c2)
  | IFB _ THEN ct ELSE cf FI =>
      andb (no_whiles ct) (no_whiles cf)
  | WHILE _ DO _ END  =>
      false
  end.

(** This predicate yields [true] just on programs that have no while
    loops.  Using [Inductive], write a property [no_whilesR] such that
    [no_whilesR c] is provable exactly when [c] is a program with no
    while loops.  Then prove its equivalence with [no_whiles].
*)
Inductive no_whilesR: com -> Prop :=
| NW_skip : no_whilesR SKIP
| NW_ass :  forall x n, no_whilesR (x ::= n)
| NW_seq :  forall c1 c2, no_whilesR c1 -> no_whilesR c2
                          -> no_whilesR (c1;;c2)
| NW_ifb : forall b c1 c2, no_whilesR c1 -> no_whilesR c2
                           -> no_whilesR (IFB b THEN c1 ELSE c2 FI)
.

Theorem no_whiles_eqv:
   forall c, no_whiles c = true <-> no_whilesR c.
Proof.
  intro. split.
  - induction c.
    + constructor.
    + constructor.
    + constructor.
      * inversion H. apply andb_true_iff in H1. apply IHc1.
        destruct H1 as [H1_1 H1_2]. assumption.
      * inversion H. apply andb_true_iff in H1. apply IHc2.
        destruct H1 as [H1_1 H1_2]. assumption.
    + constructor.
      * inversion H. apply andb_true_iff in H1. apply IHc1.
        destruct H1 as [H1_1 H1_2]. assumption.
      * inversion H. apply andb_true_iff in H1. apply IHc2.
        destruct H1 as [H1_1 H1_2]. assumption.
    + admit.
  - intro. induction H.
    + constructor.
    + constructor.
    + simpl. apply andb_true_iff. split.
      * assumption.
      * assumption.
    + simpl. apply andb_true_iff. split.
      * assumption.
      * assumption.

Qed.

(** **** Exercise: 4 stars (no_whiles_terminating)  *)
(** Imp programs that don't involve while loops always terminate.
    State and prove a theorem [no_whiles_terminating] that says this. *)
(** Use either [no_whiles] or [no_whilesR], as you prefer. *)

(** **** Exercise: 3 stars, optional (short_circuit)  *)
(** Most modern programming languages use a "short-circuit" evaluation
    rule for boolean [and]: to evaluate [BAnd b1 b2], first evaluate
    [b1].  If it evaluates to [false], then the entire [BAnd]
    expression evaluates to [false] immediately, without evaluating
    [b2].  Otherwise, [b2] is evaluated to determine the result of the
    [BAnd] expression.

    Write an alternate version of [beval] that performs short-circuit
    evaluation of [BAnd] in this manner, and prove that it is
    equivalent to [beval]. *)

(** **** Exercise: 4 stars, optional (add_for_loop)  *)
(** Add C-style [for] loops to the language of commands, update the
    [ceval] definition to define the semantics of [for] loops, and add
    cases for [for] loops as needed so that all the proofs in this file
    are accepted by Coq.

    A [for] loop should be parameterized by (a) a statement executed
    initially, (b) a test that is run on each iteration of the loop to
    determine whether the loop should continue, (c) a statement
    executed at the end of each loop iteration, and (d) a statement
    that makes up the body of the loop.  (You don't need to worry
    about making up a concrete Notation for [for] loops, but feel free
    to play with this too if you like.) *)


From stdpp Require Import numbers list.
From CoqCP Require Import Options ListsEqual SwapUpdate ListRange.

Section selectionSort.
Context {A : Type} (default : A) (compare : A -> A -> bool) (l : list A).

Definition pickSmallestInRange (left right : nat) (l : list A) :=
  foldl (fun accumulated current => if compare (nth current l default) (nth accumulated l default) then current else accumulated) left (range2 left right).

Definition selectionSort :=
  foldl (fun accumulated i => swap accumulated i (pickSmallestInRange i (length l - 1) accumulated) default) l (range (length l)).

End selectionSort.

Definition selectionSortDemo (l : list nat) : list nat := selectionSort 0 Nat.ltb l.


Set Implicit Arguments.

Require Import Coq.Bool.Bool.
Require Import vecs_new.
Require Import andnot_new.
Require Import classical_new.

Lemma bool_destr : forall b, b = false \/ b = true.
Proof.
  destruct b.
  right; reflexivity.
  left; reflexivity.
Qed.

Definition f_vec (n : nat) : vec bool n :=
  const_vec n false.

Definition t_vec (n : nat) : vec bool n :=
  const_vec n true.

Definition f_preserving (n : nat) (g : conn n) :=
  g (f_vec n) = false.

Definition t_preserving (n : nat) (g : conn n) :=
  g (t_vec n) = true.

(* takes [x1,...xk] => [negb x1,..., negb xk] *)
Fixpoint negated (k : nat) : vec bool k -> vec bool k :=
  match k as k return vec bool k -> vec bool k with
    0   => fun _ => (tt : vec bool 0)
  | S l => fun v => (negb (vhead v) , negated l (vtail v) )
  end.

Lemma negated_invol : forall (n : nat)(v : vec bool n),
  negated n (negated n v) = v.
Proof.
  intros.
  induction n.
  destruct v; simpl.
  reflexivity.
  destruct v.
  simpl.
  rewrite negb_involutive.
  rewrite IHn.
  reflexivity.
Qed.

Lemma negated_correct : forall (n : nat)(v : vec bool n)(i : fin n),
  item_at bool n i (negated n v) = negb (item_at bool n i v).
Proof.
  intros.
  induction n.
  destruct i.
  destruct v.
  destruct i.
  destruct u.
  simpl.
  reflexivity.
  simpl.
  apply IHn.
Qed.

Definition dual (n : nat) (g : conn n) :=
  fun v : vec bool n => negb (g (negated n v)).

Definition self_dual (n : nat)(g : conn n) : Prop :=
  g [=] dual g.

Definition monotone (n : nat) (g : conn n) :=
  forall x y : vec bool n,
  vec_le n x y ->
  bool_le (g x) (g y).

Lemma bool_le_dec : decidable2 bool_le.
Proof.
  intro b.
  destruct b.
  intro c.
  destruct c.
  left; simpl; reflexivity.
  right; simpl; intro; exact H.
  simpl.
  intro; left; reflexivity.
Qed.

Lemma le_dec : forall n : nat, decidable2 (vec_le n).
Proof.
  induction n.
  intros v w.
  simpl; left; reflexivity.
  intros v w.
  destruct v as [b v'], w as [c w'].
  destruct b.
  destruct c.
  destruct (IHn v' w').
  left; simpl.
  split.
  reflexivity.
  exact H.
  right; simpl.
  intro.
  apply H.
  apply H0.
  right; simpl.
  intro.
  apply H.
  destruct (IHn v' w').
  left.
  simpl.
  split.
  reflexivity.
  exact H.
  right.
  simpl.
  intro.
  apply H.
  apply H0.
Qed.

Fixpoint neg_at (n : nat) : vec bool n -> fin n -> vec bool n :=
  match n as n return vec bool n -> fin n -> vec bool n with
   0     => fun v i => (emptyf (vec bool 0) i)
  |(S m) => fun v i => match i with
                          inl tt => (negb (vhead v), (vtail v))
                         |inr j  => (vhead v , neg_at m (vtail v) j)
                       end
  end.

Lemma neg_at_correct : forall (n : nat)(v : vec bool n)(i : fin n),
  (item_at bool n i (neg_at n v i)) = negb (item_at bool n i v).
Proof.
  intros.
  induction n.
  destruct i.
  destruct v as [b w].
  destruct i.
  destruct u.
  simpl; reflexivity.
  simpl.
  apply IHn.
Qed.

Lemma neg_at_invol : forall (n : nat)(v : vec bool n)(i : fin n),
  v = neg_at n (neg_at n v i) i.
Proof.
  intros.
  induction n.
  destruct i.
  destruct v as [b w].
  destruct i.
  destruct u.
  simpl.
  rewrite negb_involutive; reflexivity.
  simpl.
  rewrite <- IHn.
  reflexivity.
Qed.

Definition is_dummy (n :nat) (g : conn n) (i : fin n) : Prop :=
  forall v : vec bool n,
  g v = g (neg_at n v i).

Definition is_counted (n :nat) (g : conn n) (i : fin n) : Prop :=
  forall v : vec bool n,
  g v = negb (g (neg_at n v i)).

Definition counting (n : nat) (g : conn n) :=
  forall i : fin n,
  (is_dummy g i) \/ (is_counted g i).

Definition non_fp_def(X : forall n:nat, conn n -> Prop) :=
  exists (n:nat)(f:conn n), ~f_preserving f /\ Definable X f.
Definition non_tp_def(X : forall n:nat, conn n -> Prop) :=
  exists (n:nat)(f:conn n), ~t_preserving f /\ Definable X f.
Definition non_monotone_def(X : forall n:nat, conn n -> Prop) :=
  exists (n:nat)(f:conn n), ~monotone f /\ Definable X f.
Definition non_selfdual_def(X : forall n:nat, conn n -> Prop) :=
  exists (n:nat)(f:conn n), ~self_dual f /\ Definable X f.
Definition non_counting_def(X : forall n:nat, conn n -> Prop) :=
  exists (n:nat)(f:conn n), ~counting f /\ Definable X f.

(* idea: fun x => f(x,....x) *)
Definition diag(n : nat) : conn n -> conn 1 :=
  fun f => comp 1 f (const_vec n ID).

Lemma diag_def(X : forall n:nat, conn n -> Prop) : forall (n : nat)(f : conn n), Definable X f -> Definable X (diag f).
Proof.
  intros.
  apply compose.
  exact H.
  intros.
  rewrite const_vec_constant.
  apply id_def.
Qed.

Lemma ID_cons_vec(n : nat)(x : bool) : vec_ap bool n (const_vec n ID) (x,tt) = const_vec n x.
Proof.
  apply vec_ext.
  intro i.
  rewrite vec_ap_lemma.
  rewrite const_vec_constant.
  rewrite const_vec_constant.
  simpl.
  reflexivity.
Qed.

(* first part of Lemma 1 from the paper *)
Lemma non_fp_non_tp_TF_or_NOT(X : forall n:nat, conn n -> Prop) : non_fp_def X -> non_tp_def X ->
  (Definable X NOT) \/ (Definable X (const 1 true) /\ Definable X (const 1 false)).
Proof.
  intros.
  destruct H as [m [f [H_f D_f]]].
  destruct H0 as [n [g [H_g D_g]]].
  assert (Definable X (diag f)).
  apply diag_def; exact D_f.
  assert (Definable X (diag g)).
  apply diag_def; exact D_g.
  assert (diag f [false] = negb false).
  unfold diag.
  unfold comp.
  rewrite ID_cons_vec.
  unfold f_preserving, f_vec in H_f.
  destruct (f (const_vec m false)).
  reflexivity.
  elim H_f; reflexivity.
  simpl in H1.
  destruct (bool_destr (diag f [true])).
  left.
  apply (def_ext H).
  intro x.
  destruct x.
  destruct b,v.
  exact H2.
  exact H1.
  assert (diag g [true] = negb true).
  unfold diag.
  unfold comp.
  rewrite ID_cons_vec.
  unfold t_preserving, t_vec in H_g.
  destruct (g (const_vec n true)).
  elim H_g; reflexivity.
  reflexivity.
  simpl in H3.
  destruct (bool_destr (diag g [false])).
  right.
  split.
  apply (def_ext H).
  destruct v.
  destruct b,v.
  exact H2.
  exact H1.
  apply (def_ext H0).
  destruct v.
  destruct b,v.
  exact H3.
  exact H4.
  left.
  apply (def_ext H0).
  destruct v.
  destruct b,v.
  exact H3.
  exact H4.
Qed.

(* Given two booleans, outputs the unary connective with that truth table*)
Fixpoint ttable_func(x : bool * bool) : conn 1 :=
  match x with
  |(false , false) => (const 1 false)
  |(false , true ) => ID
  |(true , false ) => NOT
  |(true , true  ) => (const 1 true)
  end.

Fixpoint vec_prod(n : nat) : vec bool n -> vec bool n -> vec (bool * bool) n :=
  match n as n return vec bool n -> vec bool n -> vec (bool * bool) n with
   0     => fun _ _ => (tt : vec (bool * bool) 0)
  |(S m) => fun v w => ( ((vhead v),(vhead w)) , vec_prod m (vtail v) (vtail w))
  end.

Fixpoint star(n : nat) : vec bool n -> vec bool n -> vec (conn 1) n :=
  match n as n return vec bool n -> vec bool n -> vec (conn 1) n with
    0     => fun _ _ => (tt : vec (conn 1) 0)
   |(S m) => fun v w => (ttable_func (vhead v, vhead w) , star m (vtail v) (vtail w))
  end.

Lemma star_vec_app1 : forall (n : nat)(v w : vec bool n),
  vec_ap bool n (star n v w) [false] = v.
Proof.
  induction n.
  intros.
  simpl.
  destruct v; reflexivity.
  intros.
  destruct v as [b v'].
  destruct w as [c w'].
  simpl.
  rewrite IHn.
  destruct b,c; reflexivity.
Qed.

Lemma star_vec_app2 : forall (n : nat)(v w : vec bool n),
  vec_ap bool n (star n v w) [true] = w.
Proof.
  induction n.
  intros.
  simpl.
  destruct w; reflexivity.
  intros.
  destruct v as [b v'].
  destruct w as [c w'].
  simpl.
  rewrite IHn.
  destruct b,c; reflexivity.
Qed.

Lemma non_mon_witnesses : forall (n : nat)(f : conn n), ~monotone f -> exists v w : vec bool n,
  vec_le n v w /\ f v = true /\ f w = false.
Proof.
  intros.
  assert (exists v w, ~(vec_le n v w -> bool_le (f v) (f w))).
  apply vec_bool_QDP2.
  apply impl_dec2.
  apply le_dec.
  intros x y.
  apply bool_le_dec.
  exact H.
  destruct H0 as [v [w H1]].
  exists v,w.
  split.
  destruct (le_dec n v w).
  exact H0.
  elim H1.
  intro; contradiction.
  split.
  destruct (f v).
  reflexivity.
  elim H1.
  intros; simpl; reflexivity.
  destruct (f w).
  elim H1.
  intros.
  destruct (f v); reflexivity.
  reflexivity.
Qed.

Lemma star_cases_le : forall (n : nat)(v w : vec bool n)(i : fin n),  vec_le n v w ->
   ((const 1 false) = item_at (conn 1) n i (star n v w)) \/
   (             ID = item_at (conn 1) n i (star n v w)) \/
   ( (const 1 true) = item_at (conn 1) n i (star n v w)).
Proof.
  intros.
  induction n.
  destruct i.
  destruct v as [b v'], w as [c w'].
  destruct i.
  destruct b,c,u; simpl.
  right; right; reflexivity.
  simpl in H.
  destruct H; contradiction.
  right; left; reflexivity.
  left; reflexivity.
  simpl.
  apply IHn.
  apply H.
Qed.

Lemma NOT_defined(X : forall n:nat, conn n -> Prop) : non_fp_def X -> non_tp_def X -> non_monotone_def X -> Definable X NOT.
Proof.
  intros.
  destruct (non_fp_non_tp_TF_or_NOT H H0).
  exact H2.
  destruct H2.
  destruct H1 as [n [f [f_not f_def]]].
  destruct (non_mon_witnesses f_not) as [v [w [v_le_w [v_val w_val]]]].
  assert (Definable X (comp 1 f (star n v w))).
  apply compose.
  exact f_def.
  intro.
  destruct (star_cases_le n v w i v_le_w).
  rewrite <- H1; exact H3.
  destruct H1.
  rewrite <- H1; apply id_def.
  rewrite <- H1; exact H2.
  apply (def_ext H1).
  intro x.
  destruct x.
  destruct v0.
  destruct b.
  unfold comp; rewrite star_vec_app2.
  rewrite w_val; reflexivity.
  unfold comp; rewrite star_vec_app1.
  rewrite v_val; reflexivity.
Qed.

Lemma non_dual_witness : forall (n : nat)(f : conn n),~self_dual f -> exists v : vec bool n,
  f v = f (negated n v).
Proof.
  intros.
  cut (exists v : vec bool n, ~~f v = f (negated n v)).
  intro.
  destruct H0.
  exists x.
  destruct (bool_dec (f x) (f (negated n x))).
  exact e.
  contradiction.
  apply vec_bool_QDP.
  intro.
  destruct (bool_dec (f x) (f (negated n x))).
  right; intro; contradiction.
  left; exact n0.
  intro.
  absurd ((forall v : vec bool n, f v = negb (f (negated n v)))).
  exact H.
  intro.
  destruct (bool_dec (f v) (f (negated n v))).
  elim (H0 v).
  exact e.
  destruct (f v) , (f (negated n v)).
  elim n0; reflexivity.
  reflexivity.
  reflexivity.
  elim  n0; reflexivity.
Qed.

Lemma star_cases_negated : forall (n : nat)(v : vec bool n)(i : fin n),
   (ID  = item_at (conn 1) n i (star n v (negated n v))) \/
   (NOT = item_at (conn 1) n i (star n v (negated n v))).
Proof.
  intros.
  induction n.
  destruct i.
  destruct v as [b w].
  destruct i.
  destruct b,u.
  simpl.
  right; reflexivity.
  simpl.
  left; reflexivity.
  simpl.
  apply IHn.
Qed.

Lemma F_defined(X : forall n:nat, conn n -> Prop) : non_fp_def X -> non_tp_def X -> non_monotone_def X -> non_selfdual_def X
  -> Definable X (const 1 false).
Proof.
  intros.
  pose (NOT_defined H H0 H1) as not_def.
  destruct H2 as [n [f [f_not f_def]]].
  assert (exists v : vec bool n,  f v = f (negated n v)).
  apply non_dual_witness.
  exact f_not.
  destruct H2 as [v f_eq].
  assert (Definable X (comp 1 f (star n v (negated n v)))).
  apply compose.
  exact f_def.
  intro i.
  destruct (star_cases_negated n v i).
  rewrite <- H2; apply id_def.
  rewrite <- H2; exact not_def.
  destruct (bool_destr (f v)).
  apply (def_ext H2).
  intro x.
  unfold comp.
  destruct x.
  destruct b,v0.
  rewrite star_vec_app2.
  rewrite <- f_eq; rewrite H3; reflexivity.
  rewrite star_vec_app1.
  rewrite H3; reflexivity.
  assert (Definable X (comp 1 NOT [comp 1 f (star n v (negated n v)) ] )).
  apply unit_comp_def.
  exact not_def.
  apply compose.
  exact f_def.
  intro i.
  destruct (star_cases_negated n v i).
  rewrite <- H4; apply id_def.
  rewrite <- H4; exact not_def.
  apply (def_ext H4).
  intro x.
  unfold comp.
  destruct x.
  destruct b,v0.
  simpl.
  rewrite star_vec_app2.
  rewrite <- f_eq; rewrite H3; reflexivity.
  simpl.
  rewrite star_vec_app1.
  rewrite H3; reflexivity.
Qed.

Lemma T_defined(X : forall n:nat, conn n -> Prop) : non_fp_def X -> non_tp_def X -> non_monotone_def X -> non_selfdual_def X
  -> Definable X (const 1 true).
Proof.
  intros.
  pose (NOT_defined H H0 H1) as not_def.
  pose (F_defined H H0 H1 H2) as f_def.
  assert (Definable X (comp 1 NOT [const 1 false])).
  apply unit_comp_def.
  exact not_def.
  exact f_def.
  apply (def_ext H3).
  intro x.
  unfold comp.
  reflexivity.
Qed.

Fixpoint neg_vec (n : nat) : fin n -> vec (conn 1) (S n) :=
  match n as n return fin n -> vec (conn 1) (S n) with
  |0     => fun i => emptyf (vec (conn 1) 1) i
  |(S m) => fun i => match i with
                     |inl u => (NOT , const_vec (S m) ID )
                     |inr j => (ID  , (neg_vec m j)      )
                     end
  end.

Lemma dummy_dec : forall (n:nat)(f : conn n)(i : fin n),
  is_dummy f i \/ ~is_dummy f i.
Proof.
  intros.
  unfold is_dummy.
  assert ((exists v, f v <> f (neg_at n v i))\/(~exists v, f v <> f (neg_at n v i))).
  apply vec_bool_ExEM.
  intro.
  destruct (bool_dec (f x) (f (neg_at n x i))).
  right; intro; contradiction.
  left; exact n0.
  destruct H.
  right.
  intro.
  destruct H as [v Hv].
  apply Hv.
  apply H0.
  left.
  intro.
  destruct (bool_dec (f v) (f (neg_at n v i))).
  exact e.
  elim H.
  exists v; exact n0.
Qed.

Lemma count_dec : forall (n:nat)(f : conn n)(i : fin n),
  is_counted f i \/ ~is_counted f i.
Proof.
  intros.
  unfold is_counted.
  assert ((exists v, f v <> negb (f (neg_at n v i)))\/(~exists v, f v <> negb (f (neg_at n v i)))).
  apply vec_bool_ExEM.
  intro.
  destruct (bool_dec (f x) (negb (f (neg_at n x i)))).
  right; intro; contradiction.
  left; exact n0.
  destruct H.
  right; intro.
  destruct H as [v Hv].
  apply Hv.
  apply H0.
  left.
  intro.
  destruct (bool_dec (f v) (f (neg_at n v i))).
  elim H.
  exists v.
  intro.
  rewrite <- e in H0.
  symmetry in H0.
  exact (no_fixpoint_negb (f v) H0).
  destruct (f v) , (f  (neg_at n v i)).
  elim n0; reflexivity.
  reflexivity.
  reflexivity.
  elim n0; reflexivity.
Qed.

Lemma non_counting_index : forall (n : nat)(f : conn n), ~counting f ->
  exists i, (~is_dummy f i)/\(~is_counted f i).
Proof.
  intros.
  assert (exists i, ~(is_dummy f i \/ is_counted f i)).
  apply finQDP.
  intro.
  apply or_dec0.
  apply dummy_dec.
  apply count_dec.
  exact H.
  destruct H0 as [i H0].
  exists i.
  tauto.
Qed.

Lemma dummy_vec_witness : forall (n : nat)(f : conn n)(i : fin n),
   ~is_dummy f i -> exists v, f v <> f (neg_at n v i).
Proof.
  intros.
  apply vec_bool_QDP.
  intro.
  destruct (bool_dec (f x)  (f (neg_at n x i))).
  left; exact e.
  right; exact n0.
  exact H.
Qed.

Lemma count_vec_witness : forall (n : nat)(f : conn n)(i : fin n),
  ~is_counted f i -> exists v, f v = f (neg_at n v i).
Proof.
  intros.
  assert (exists v, ~f v = negb ( f (neg_at n v i))).
  apply vec_bool_QDP.
  intro.
  destruct (bool_dec (f x) (f (neg_at n x i))).
  right; rewrite e.
  intro; symmetry in H0.
  apply (no_fixpoint_negb (f (neg_at n x i)) H0).
  left; destruct (f x) , (f (neg_at n x i)).
  elim n0; reflexivity.
  reflexivity.
  reflexivity.
  elim n0; reflexivity.
  exact H.
  destruct H0 as [v Hv].
  exists v.
  destruct (f v),(f (neg_at n v i)).
  reflexivity.
  elim Hv; reflexivity.
  elim Hv; reflexivity.
  reflexivity.
Qed.

Lemma non_counting_witnesses : forall (n : nat)(f : conn n),
  ~counting f -> exists (i : fin n)(v w : vec bool n),
   f v <> f (neg_at n v i) /\ (f w = f (neg_at n w i)).
Proof.
  intros.
  destruct (non_counting_index H) as [i [Hd Hc]].
  destruct (dummy_vec_witness Hd) as [v Hv].
  destruct (count_vec_witness Hc) as [w Hw].
  exists i,v,w.
  split.
  exact Hv.
  exact Hw.
Qed.

(*WLOG we want the the component at index i to be F to simplify matters. *)
Lemma non_counting_witnesses_F : forall (n : nat)(f : conn n),
  ~counting f -> exists (i : fin n)(v w : vec bool n),
   item_at bool n i v = false /\ item_at bool n i w = false /\
   f v <> f (neg_at n v i) /\ (f w = f (neg_at n w i)).
Proof.
  intros.
  destruct (non_counting_witnesses H) as [i [v [w [Hv Hw]]]].
  destruct (bool_destr (item_at bool n i v)).
  destruct (bool_destr (item_at bool n i w)).
  exists i,v,w.
  tauto.
  exists i,v,(neg_at n w i).
  split.
  exact H0.
  split.
  rewrite neg_at_correct.
  rewrite H1; reflexivity.
  split.
  exact Hv.
  rewrite <-neg_at_invol.
  symmetry; exact Hw.
  destruct (bool_destr (item_at bool n i w)).
  exists i,(neg_at n v i),w.
  split.
  rewrite neg_at_correct.
  rewrite H0; reflexivity.
  split.
  exact H1.
  split.
  rewrite <-neg_at_invol.
  intro.
  apply Hv.
  symmetry; exact H2.
  exact Hw.
  exists i,(neg_at n v i),(neg_at n w i).
  split.
  rewrite neg_at_correct.
  rewrite H0; reflexivity.
  split.
  rewrite neg_at_correct.
  rewrite H1; reflexivity.
  split.
  rewrite <-neg_at_invol.
  intro.
  apply Hv.
  symmetry; exact H2.
  rewrite <- neg_at_invol.
  symmetry; exact Hw.
Qed.

Fixpoint star2(n : nat) : vec bool n -> vec bool n -> vec (conn 2) n :=
  match n as n return vec bool n -> vec bool n -> vec (conn 2) n with
    0     => fun _ _ => (tt : vec (conn 2) 0)
   |(S m) => fun v w => (comp 2 (ttable_func (fst v,fst w)) [p1] , star2 m (snd v) (snd w))
  end.

Lemma star2_def(X : forall n:nat, conn n -> Prop)(n : nat)(v w : vec bool n) :
  Definable X NOT -> Definable X (fun x:(vec bool 1) => false) -> Definable X (fun x:(vec bool 1) => true) ->
  forall i : fin n, Definable X (item_at (conn 2) n i (star2 n v w)).
Proof.
  intros.
  induction n.
  destruct i.
  destruct i.
  destruct v,w.
  destruct b,b0,u; simpl.
  apply unit_comp_def.
  exact H1.
  apply project.
  apply unit_comp_def.
  exact H.
  apply project.
  apply unit_comp_def.
  apply id_def.
  apply project.
  apply unit_comp_def.
  apply H0.
  apply project.
  simpl.
  apply IHn.
Qed.

Lemma star2_F : forall (n : nat)(v w : vec bool n)(b : bool),
  vec_ap bool n (star2 n v w) [false , b] = v.
Proof.
  intros.
  induction n.
  simpl.
  destruct v; reflexivity.
  destruct v,w.
  destruct b0,b1; simpl; unfold comp; simpl; rewrite IHn; reflexivity.
Qed.

Lemma star2_T : forall (n : nat)(v w : vec bool n)(b : bool),
  vec_ap bool n (star2 n v w) [true , b] = w.
Proof.
  intros.
  induction n.
  simpl.
  destruct w; reflexivity.
  destruct v,w.
  destruct b0,b1; simpl; unfold comp; simpl; rewrite IHn; reflexivity.
Qed.

Fixpoint star_mod(n : nat) : vec bool n -> vec bool n -> fin n -> vec (conn 2) n :=
  match n as n return vec bool n -> vec bool n -> fin n -> vec (conn 2) n with
    0     => fun v w i => emptyf (vec (conn 2) 0) i
   |(S m) => fun v w i => match i with
                             inl u => (p2,star2 m (vtail v) (vtail w))
                            |inr j => ((comp 2 (ttable_func (fst v,fst w)) [ p1 ]), star_mod m (snd v)(snd w) j)
                          end
  end.

Lemma star_mod_def(X : forall n:nat, conn n -> Prop)(n : nat)(v w : vec bool n) :
  Definable X NOT -> Definable X (fun x:(vec bool 1) => false) -> Definable X (fun x:(vec bool 1) => true) ->
  forall i j: fin n, Definable X (item_at (conn 2) n j (star_mod n v w i)).
Proof.
  intros.
  induction n.
  destruct i.
  destruct v,w.
  destruct i,j.
  destruct u,u0; simpl.
  apply project.
  simpl.
  apply star2_def.
  exact H.
  exact H0.
  exact H1.
  destruct u.
  destruct b,b0.
  simpl.
  apply unit_comp_def.
  exact H1.
  apply project.
  simpl.
  apply unit_comp_def.
  exact H.
  apply project.
  simpl.
  apply unit_comp_def.
  apply id_def.
  apply project.
  simpl.
  apply unit_comp_def.
  exact H0.
  apply project.
  simpl.
  apply IHn.
Qed.

Lemma star_mod_FF(n : nat)(v w : vec bool n)(i : fin n) :
  item_at bool n i v = false -> item_at bool n i w = false ->
  vec_ap bool n (star_mod n v w i) [false , false] = v.
Proof.
  intros.
  induction n.
  destruct i.
  destruct i,v,w.
  destruct b,u; simpl.
  discriminate H.
  destruct b0; simpl.
  discriminate H0.
  unfold p2, proj.
  simpl.
  rewrite star2_F; reflexivity.
  destruct b,b0.
  simpl.
  unfold comp, const; rewrite IHn.
  reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp, const; rewrite IHn.
  simpl; reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp; rewrite IHn.
  simpl; reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp, const; rewrite IHn.
  reflexivity.
  exact H.
  exact H0.
Qed.

Lemma star_mod_TF(n : nat)(v w : vec bool n)(i : fin n) :
  item_at bool n i v = false -> item_at bool n i w = false ->
  vec_ap bool n (star_mod n v w i) [true , false] = w.
Proof.
  intros.
  induction n.
  destruct i.
  destruct i,v,w.
  destruct b,u; simpl.
  discriminate H.
  destruct b0; simpl.
  discriminate H0.
  unfold p2, proj.
  simpl.
  rewrite star2_T; reflexivity.
  destruct b,b0.
  simpl.
  unfold comp, const; rewrite IHn.
  reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp, const; rewrite IHn.
  simpl; reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp; rewrite IHn.
  simpl; reflexivity.
  exact H.
  exact H0.
  simpl.
  unfold comp, const; rewrite IHn.
  reflexivity.
  exact H.
  exact H0.
Qed.

Lemma star_mod_bT(n : nat)(v w : vec bool n)(i : fin n)(b : bool) :
  neg_at n (vec_ap bool n (star_mod n v w i) [ b , true]) i =
  (vec_ap bool n (star_mod n v w i) [ b , false]).
Proof.
  induction n.
  destruct i.
  destruct v,w,i.
  destruct u,b0,b1.
  simpl.
  unfold p2,proj.
  simpl.
  destruct b.
  rewrite star2_T.
  rewrite star2_T.
  reflexivity.
  rewrite star2_F.
  rewrite star2_F.
  reflexivity.
  simpl.
  unfold p2,proj.
  simpl.
  destruct b.
  rewrite star2_T.
  rewrite star2_T.
  reflexivity.
  rewrite star2_F.
  rewrite star2_F.
  reflexivity.
  simpl.
  unfold p2,proj.
  simpl.
  destruct b.
  rewrite star2_T.
  rewrite star2_T.
  reflexivity.
  rewrite star2_F.
  rewrite star2_F.
  reflexivity.
  simpl.
  unfold p2,proj.
  simpl.
  destruct b.
  rewrite star2_T.
  rewrite star2_T.
  reflexivity.
  rewrite star2_F.
  rewrite star2_F.
  reflexivity.
  simpl.
  unfold comp.
  unfold p1,proj.
  simpl.
  destruct b0; destruct b1; rewrite IHn; reflexivity.
Qed.

Lemma star_mod_bT2(n : nat)(v w : vec bool n)(i : fin n)(b : bool) :
  (vec_ap bool n (star_mod n v w i) [b , true]) =
   neg_at n (vec_ap bool n (star_mod n v w i) [b , false]) i.
Proof.
  rewrite (neg_at_invol n (vec_ap bool n (star_mod n v w i) [b , true]) i).
  f_equal.
  apply star_mod_bT.
Qed.

Definition one_F(f : conn 2) := exists v,
  (f v = false /\ forall w, w<>v -> f w = true).

Definition one_T(f : conn 2) := exists v,
  (f v = true /\ forall w, w<>v -> f w = false).

Lemma odd_from_not_counting(X : forall n:nat, conn n -> Prop) :
  Definable X NOT -> Definable X (fun x:(vec bool 1) => false) -> Definable X (fun x:(vec bool 1) => true) ->
  non_counting_def X ->
  exists g : conn 2, Definable X g /\ (one_F g \/ one_T g).
Proof.
  intros.
  destruct H2 as [n [f [f_nc f_def]]].
  destruct (non_counting_witnesses_F f_nc) as [i [v [w [v_i [w_i [Hnd Hnc]]]]]].
  exists (comp 2 f (star_mod n v w i)).
  split.
  apply compose.
  exact f_def.
  apply star_mod_def.
  exact H.
  exact H0.
  exact H1.
  destruct  (bool_destr (f w)).
  destruct (bool_destr (f v)).
  right.
  exists [false , true].
  split.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_FF n v w i v_i w_i).
  apply not_false_is_true.
  intro; apply Hnd.
  rewrite H3; symmetry; exact H4.
  intro x.
  destruct x as (b,(b0,v0)).
  destruct b,b0,v0.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_TF n v w i v_i w_i).
  rewrite <- Hnc; exact H2.
  intro.
  unfold comp.
  rewrite star_mod_TF.
  exact H2.
  exact v_i.
  exact w_i.
  intro.
  elim H4; reflexivity.
  intro.
  unfold comp.
  rewrite star_mod_FF.
  exact H3.
  exact v_i.
  exact w_i.
  right.
  exists [false , false].
  split.
  unfold comp.
  rewrite (star_mod_FF n v w i v_i w_i).
  exact H3.
  intro x; destruct x as (b,(b0,v0)).
  destruct b,b0,v0.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_TF n v w i v_i w_i).
  rewrite <- Hnc; exact H2.
  intro.
  unfold comp.
  rewrite star_mod_TF.
  exact H2.
  exact v_i.
  exact w_i.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_FF n v w i v_i w_i).
  apply not_true_is_false.
  intro.
  apply Hnd.
  rewrite H5; exact H3.
  intro.
  elim H4.
  reflexivity.
  destruct (bool_destr (f v)).
  left.
  exists [false, false].
  split.
  unfold comp.
  rewrite (star_mod_FF n v w i v_i w_i).
  exact H3.
  intro x; destruct x as (b,(b0,v0)).
  destruct b,b0,v0.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_TF n v w i v_i w_i).
  rewrite <- Hnc; exact H2.
  intro.
  unfold comp.
  rewrite star_mod_TF.
  exact H2.
  exact v_i.
  exact w_i.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_FF n v w i v_i w_i).
  apply not_false_is_true.
  intro.
  apply Hnd.
  rewrite H5; exact H3.
  intro.
  elim H4; reflexivity.
  left.
  exists [false , true].
  split.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_FF n v w i v_i w_i).
  apply not_true_is_false.
  intro.
  apply Hnd.
  rewrite H4; exact H3.
  intro x; destruct x as (b,(b0,v0)).
  destruct b,b0,v0.
  intro.
  unfold comp.
  rewrite star_mod_bT2.
  rewrite (star_mod_TF n v w i v_i w_i).
  rewrite <- Hnc; exact H2.
  intro.
  unfold comp.
  rewrite star_mod_TF.
  exact H2.
  exact v_i.
  exact w_i.
  intro.
  elim H4; reflexivity.
  intro.
  unfold comp.
  rewrite star_mod_FF.
  exact H3.
  exact v_i.
  exact w_i.
Qed.

Lemma neg_one_F_one_T : forall f, one_F f -> one_T (comp 2 NOT [ f ]).
Proof.
  intros.
  destruct H as [v [Hv Hw]].
  exists v.
  split.
  unfold comp.
  simpl.
  rewrite Hv; reflexivity.
  intros.
  unfold comp.
  simpl.
  rewrite (Hw w H).
  reflexivity.
Qed.

Lemma one_FT_to_one_T(X : forall n:nat, conn n -> Prop) :
  Definable X NOT -> (exists f, Definable  X f /\ (one_F f \/ one_T f)) -> (exists f, Definable X f /\ one_T f).
Proof.
  intros.
  destruct H0 as [f H0].
  destruct H0.
  destruct H1.
  exists (comp 2 NOT [f] ).
  split.
  apply unit_comp_def.
  exact H.
  exact H0.
  apply (neg_one_F_one_T H1).
  exists f.
  split.
  exact H0.
  exact H1.
Qed.

Lemma odd_and_def(X : forall n:nat, conn n -> Prop) : Definable X NOT -> (exists f, Definable  X f /\ (one_F f \/ one_T f))
  -> Definable X AND.
Proof.
  intros.
  destruct (one_FT_to_one_T H H0) as [f [Hdef [v [Hv Hw]]]].
  destruct v as (b,(b0,v0)).
  destruct b,b0,v0.
  apply (def_ext Hdef).
  intro v.
  destruct v as (c,(c0,w0)).
  destruct c,c0,w0.
  rewrite Hv; reflexivity.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  apply and_from_or_not.
  apply or_from_impl_not.
  assert (Definable X (comp 2 NOT [f])).
  apply unit_comp_def.
  exact H.
  exact Hdef.
  apply (def_ext H1).
  unfold comp.
  intro v.
  destruct v as (c,(c0,w0)).
  destruct c,c0,w0; simpl.
  rewrite Hw.
  reflexivity.
  discriminate.
  symmetry; apply negb_sym.
  transitivity true.
  exact Hv.
  reflexivity.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  exact H.
  exact H.
  apply and_from_or_not.
  apply or_from_rimpl_not.
  assert (Definable X (comp 2 NOT [f])).
  apply unit_comp_def.
  exact H.
  exact Hdef.
  apply (def_ext H1).
  intro v.
  destruct v as (c,(c0,w0)).
  destruct c,c0,w0; unfold comp; simpl.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  symmetry; apply negb_sym.
  exact Hv.
  rewrite Hw.
  reflexivity.
  discriminate.
  exact H.
  exact H.
  apply and_from_or_not.
  assert (Definable X (comp 2 NOT [f])).
  apply unit_comp_def.
  exact H.
  exact Hdef.
  apply (def_ext H1).
  intro v.
  destruct v as (c,(c0,v0)).
  destruct c,c0,v0; unfold comp; simpl.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  rewrite Hw.
  reflexivity.
  discriminate.
  symmetry; apply negb_sym.
  exact Hv.
  exact H.
Qed.

Lemma FC_from_five(X : forall n:nat, conn n -> Prop) :
  (non_fp_def X /\ non_tp_def X /\ non_monotone_def X/\
   non_selfdual_def X/\ non_counting_def X)
  -> FC X.
Proof.
  intro.
  destruct H as [H_fp [H_tp [H_mon [H_sd H_c]]]].
  apply and_not_func_complete.
  apply odd_and_def.
  apply NOT_defined.
  exact H_fp.
  exact H_tp.
  exact H_mon.
  apply odd_from_not_counting.
  apply NOT_defined.
  exact H_fp.
  exact H_tp.
  exact H_mon.
  apply (def_ext (F_defined H_fp H_tp H_mon H_sd)).
  intro.
  auto.
  apply (def_ext (T_defined H_fp H_tp H_mon H_sd)).
  intro.
  auto.
  exact H_c.
  apply NOT_defined.
  exact H_fp.
  exact H_tp.
  exact H_mon.
Qed.

Definition non_fp(X : forall n:nat, conn n -> Prop) :=
  exists (n : nat)(f : conn n), X n f /\ ~f_preserving f.
Definition non_tp(X : forall n:nat, conn n -> Prop) :=
  exists (n : nat)(f : conn n), X n f /\ ~t_preserving f.
Definition non_mon(X : forall n:nat, conn n -> Prop) :=
  exists (n : nat)(f : conn n), X n f /\ ~monotone f.
Definition non_sd(X : forall n:nat, conn n -> Prop) :=
  exists (n : nat)(f : conn n), X n f /\ ~self_dual f.
Definition non_counting(X : forall n:nat, conn n -> Prop) :=
  exists (n : nat)(f : conn n), X n f /\ ~counting f.

Theorem Post_FC_Part_One(X : forall n:nat, conn n -> Prop) :
  (non_fp X /\ non_tp X /\ non_mon X /\ non_sd X /\ non_counting X)
   ->  FC X.
Proof.
  intro.
  destruct H as [ [n1 [f1 [X1 not_fp]]] H].
  destruct H as [ [n2 [f2 [X2 not_tp]]] H].
  destruct H as [ [n3 [f3 [X3 not_mon]]] H].
  destruct H as [ [n4 [f4 [X4 not_sd]]] H].
  destruct H as [n5 [f5 [X5 not_counting]]].
  apply FC_from_five.
  split.
  exists n1,f1.
  split.
  exact not_fp.
  apply atom_def.
  exact X1.
  split.
  exists n2,f2.
  split.
  exact not_tp.
  apply atom_def.
  exact X2.
  split.
  exists n3,f3.
  split.
  exact not_mon.
  apply atom_def.
  exact X3.
  split.
  exists n4,f4.
  split.
  exact not_sd.
  apply atom_def.
  exact X4.
  exists n5,f5.
  split.
  exact not_counting.
  apply atom_def.
  exact X5.
Qed.


Require Import Reals.
Require Import Fourier.
Require Import Psatz.
Require Import Lra.
Require Import utils.

Module RecRel.

(*
We model super general (univariate, single function) reccurence relations for now.
We'll make them more restrictive if the general definition turns out to be a hassle.

*)
Inductive Expr :=
| Var : Expr
| Tu  : Expr -> Expr
| Td  : Expr -> Expr
| Const : R -> Expr
| Sum : Expr -> Expr -> Expr
| Mul : Expr -> Expr -> Expr
| Div : Expr -> Expr -> Expr
| Fun : (R -> R) -> Expr -> Expr
.

Record Rel := { lhs : Expr; rhs : Expr }.

Print Rel.

Coercion Const : R >-> Expr.

Notation "e1 <+> e2" := (Sum e1 e2)(at level 20).
Notation "e1 <*> e2" := (Mul e1 e2)(at level 20).
Notation "e1 </> e2" := (Div e1 e2)(at level 20).
Notation "f <@> e"   := (Fun f e)(at level 19).
Notation "<n>"       := Var.

Check (_/_).
Search (_/_).

Print Rdiv.

Search (nat -> R).

Search (R -> Z).

Search (Z -> nat).

SearchAbout (Int_part _).
SearchAbout (INR _).

Locate up.
Locate down.

Fixpoint Interp (e : Expr) (f : Z -> R) (n : Z) : R :=
  match e with
      | <n> => IZR n
      | Tu e' => f (up (Interp e' f n))
      | Td e' => f (down (Interp e' f n))
      | Const c => c
      | e1 <+> e2 => (Interp e1 f n) + (Interp e2 f n)
      | e1 <*> e2 => (Interp e1 f n) * (Interp e2 f n)
      | e1 </> e2 => (Interp e1 f n) / (Interp e2 f n)
      | g <@> e  => g (Interp e f n)
  end.

Notation "[[ e ]]" := (Interp e).

Definition ValRel (r : Rel) (f : Z -> R) : Prop :=
  forall n, [[ lhs r ]] f n <= [[ rhs r ]] f n.

Notation "l :== r" := (Build_Rel l r)(at level 30).

Lemma test_lemma : forall f, ValRel (Tu <n> :== Tu ((<n> <*> 2) </> 2)) f.
Proof.
  unfold ValRel; intros; simpl Interp.

  unfold Rdiv; rewrite Rinv_r_simpl_l; auto; lra.
Qed.

Lemma test2 : ValRel (Td <n> :== 2 <*> (Tu (<n> </> 2))) (fun n => IZR n).
Proof.
  unfold ValRel; intros; simpl Interp.
  generalize (down_fund (IZR n)); intros [H1 H2].
  generalize (up_fund (IZR n / 2)); intros [H3 H4].
  nra.
Qed.

(*
We use the most straightforward definition here, we'll amend it later if needed.
 *)
Definition O (f : Z -> R) (g : Z -> R) : Prop :=
  exists n, exists C, 0 <= IZR n /\ 0 <= C /\ forall M, IZR n <= IZR M -> g M <= C * (f M).

(*This notation is the worst, but I can't quite figure out how to make it better. *)
Notation "g ∈O a":= (O a g)(at level 10).

Ltac trivial_bounds := exists 0%Z; exists 1; split; [|split]; try lra.

Ltac o_of_n_bounds n C := exists n%Z; exists C; split; [|split]; try lra.

Ltac idk_bounds := eexists; eexists; split; [|split]; try lra.

Lemma n_O_of_n_squared : (fun n => IZR n) ∈O (fun n => IZR n * IZR n).
Proof.
  o_of_n_bounds 1%Z 1; intros; nra.
Qed.

Theorem O_refl : forall f, f ∈O f.
Proof.
  trivial_bounds.
  intros; lra.
Qed.

Theorem O_trans : forall f g h, f ∈O g -> g ∈O h -> f ∈O h.
Proof.
  intros f g h (M1, (C1, H1)) (M2, (C2, H2)).
  o_of_n_bounds (Z.max M1 M2) (C1 * C2);
  destruct H1 as (H11, (H12, H1));
  destruct H2 as (H21, (H22,H2)).
  - rewrite max_IZR.
    eapply Rle_trans. apply Rmax_r.
    apply Rle_max_compat_l; now auto.

  - nra.

  - intros M le.
    assert (f M <= C1 * g M).
    + apply H1.
      rewrite max_IZR in *.
      eapply Rmax_split_l; now eauto.

    + assert (g M <= C2 * h M).
      apply H2.
      * rewrite max_IZR in *.
        eapply Rmax_split_r; now eauto.
      * nra.
Qed.

Theorem O_add_idempot : forall f g h, f ∈O (fun n => g n + h n) -> h ∈O g -> f ∈O g.
Proof.
  intros f g h (M1, (C1, H1)) (M2, (C2, H2)).
  o_of_n_bounds (Z.max M1 M2) (C1 + C1*C2);
    destruct H1 as (H11, (H12, H1));
    destruct H2 as (H21, (H22,H2)).

  - rewrite max_IZR.
    eapply Rle_trans. apply Rmax_r.
    apply Rle_max_compat_l; now auto.

  - nra.

  - intros M max_rel.
    rewrite Rmult_plus_distr_r.
    eapply Rle_trans.
    + SearchAbout (Rmax _ _ <= _ -> _).
      apply H1; rewrite max_IZR in *; eapply Rmax_split_l; eauto.
    + rewrite Rmult_plus_distr_l.
      SearchAbout (_+_<=_+_).
      apply Rplus_le_compat; try lra.
      SearchAbout (_*_<=_*_).
      rewrite Rmult_assoc.
      apply Rmult_le_compat_l; try lra.
      apply H2.
      rewrite max_IZR in *; eapply Rmax_split_r; now eauto.
Qed.

Definition monotone f := forall n m : Z, (n <= m)%Z -> f n <= f m.

Definition non_zero f := exists k:Z, f k > 0.

Definition positive f := forall k:Z, 0 <= f k.

Theorem O_mul_hyp : forall f g C, 0 <= C -> f ∈O (fun k => C * g k) -> f ∈O g.
Proof.
  intros f g C C_pos (M, (C', H)).
  o_of_n_bounds M (C' * C);
  destruct H as (H1, (H2, H)); try nra.
  intros M0 leq.
  SearchAbout ((_*_)*_).
  Check Rmult_assoc.
  rewrite Rmult_assoc.
  apply H; lra.
Qed.

Theorem O_mul_conc : forall f g C, 0 < C -> f ∈O g -> f ∈O (fun k => C * g k).
Proof.
  intros f g C nz (M, (C', (H1, (H2, H)))).
  o_of_n_bounds M (C' * / C).
  - apply Rmult_le_pos; auto.
    apply Rlt_le.
    apply Rinv_0_lt_compat; auto.
  - intros.
    replace (C' * / C * (C * g M0)) with (C' * (/ C * C) * g M0) by ring.
    rewrite Rinv_l.
    rewrite Rmult_1_r.
    auto.
    lra.
Qed.

(* A bit surprising that C needs to be positive here... *)
Theorem O_mul_src : forall f g C, 0 <= C -> f ∈O g -> (fun k => C * f k) ∈O g.
Proof.
  intros f g C C_pos (M, (C', (H1, (H2, H)))).
  o_of_n_bounds M (C * C').
  - nra.
  - intros.
    rewrite Rmult_assoc.
    apply Rmult_le_compat_l; auto.
Qed.

Theorem O_const_plus : forall f g h C, 0 <= C -> h ∈O g -> f ∈O (fun k => g k + C * h k) -> f ∈O g.
Proof.
  intros f g h C C_pos o_h_g o_f_sum.
  eapply O_add_idempot.
  apply o_f_sum.
  apply O_mul_src; auto.
Qed.

Theorem O_const : forall f c, 0 <= c -> monotone f -> non_zero f -> (fun _ => c) ∈O f.
Proof.
  intros f c c_pos mon non_zero.
  destruct non_zero as (k, k_n_z).
  o_of_n_bounds (Z.max k 1) (c * / f (Z.max k 1)).
  - rewrite max_IZR.
    SearchAbout (_ <= Rmax _ _).
    generalize (Rmax_r (IZR k) 1); lra.
  - SearchAbout (Z.max _ _).
    destruct (Z.le_ge_cases k 1) as [H1 | H2].
    + rewrite Z.max_r; auto.
    assert (f k <= f 1%Z) by (apply mon; lia).
    apply Rmult_le_pos; auto.
    apply Rlt_le.
    apply Rinv_0_lt_compat.
    lra.

    + rewrite Z.max_l; auto.
    apply Rmult_le_pos; auto.
    apply Rlt_le.
    apply Rinv_0_lt_compat.
    lra.

  - intros M le.
    rewrite Rmult_assoc.
    pattern c at 1.
    replace c with (c * 1) by ring.
    apply Rmult_le_compat_l; auto.
    pattern 1 at 1.
    replace 1 with (/ f (Z.max k 1) * f (Z.max k 1)); try apply Rinv_l.
    + apply Rmult_le_compat_l.

      -- destruct (Z.le_ge_cases k 1) as [H1 | H2];
           [|rewrite Z.max_l; now auto; apply Rlt_le; apply Rinv_0_lt_compat; now auto].
         rewrite Z.max_r; auto.
            apply Rlt_le; apply Rinv_0_lt_compat; auto.

            assert (f k <= f 1%Z) by (apply mon; lia).
            SearchAbout (_ <  _ -> _ <= _ -> _ < _).
            eapply Rlt_le_trans with (r2 := f k); auto.

      -- apply mon; apply le_IZR; auto.

    + apply Rgt_not_eq.
      destruct (Z.le_ge_cases k 1) as [H1 | H2]; [rewrite Z.max_r; auto |rewrite Z.max_l; now auto].

      assert (f k <= f 1%Z) by (apply mon; lia).
      eapply Rlt_le_trans with (r2 := f k); now auto.
Qed.

Theorem O_const_add_r : forall f g c, 0 <= c -> f ∈O g -> f ∈O (fun k => g k + c).
Proof.
  intros f g c c_pos (M, (C, (H1, (H2, H)))).
  o_of_n_bounds M C.
  intros M0 leq.
  generalize (H M0); intros.
  nra.
Qed.

(* Untrue!! *)
Theorem O_const_add_l : forall f g n, f ∈O (fun k => g k + n) -> f ∈O g.
Abort.

Theorem O_const_add_l : forall f g c, 0 <= c -> monotone g -> non_zero g -> f ∈O (fun k => g k + c) -> f ∈O g.
Proof.
  intros f g c c_pos mon non_zero o_g_const.
  eapply O_add_idempot.
  apply o_g_const.
  apply O_const; auto.
Qed.

Lemma rewrite_geq : forall H : R -> Prop, (forall x y, (y <= x) -> H x -> H y) -> forall x y, (y <= x) -> H x -> H y.
Proof.
  firstorder.
Qed.

Check ln.

Axiom I_GIVE_UP : forall {P}, P.

Lemma ln_neg_0 : forall x, x <= 0 -> ln x = 0.
Proof.
  intros x; case_eq (Rlt_dec 0 x); intros.
  - nra.
  - unfold ln.
    rewrite H; now auto.
Qed.

Lemma monotone_ln : forall x y, 0 < x -> 0 < y -> x <= y -> ln x <= ln y.
Proof.
  intros.
  case (Rlt_dec x y); intros.
  - SearchAbout (_ < _ -> _ <= _).
    apply Rlt_le.
    SearchAbout (_ < ln _).
    apply ln_increasing; now auto.
  - assert (x = y) by lra.
    subst x; lra.
Qed.

Theorem ln_plus_gt : forall x y, 1 < x -> 0 < y -> ln (x + y) < ln x + y.
Proof.
  intros x y H H0.
  SearchAbout (exp _ < _).
  apply exp_lt_inv.
  rewrite exp_plus.
  repeat rewrite exp_ln; [ | lra | lra].
  generalize (exp_ineq1 y H0); intros; nra.
Qed.

Check exp_ineq1.

Theorem ln_plus_gt2 : forall x y, 2 < x -> 0 < y -> ln (x + y) < ln x + y / 2.
  intros x y H H0.
  SearchAbout (exp _ < _).
  apply exp_lt_inv.
  rewrite exp_plus.
  repeat rewrite exp_ln; [ | lra | lra].
  assert (H1 : 0 < y / 2) by lra.
  generalize (exp_ineq1 (y/2) H1); intros; nra.
Qed.

Theorem ln_plus_gt4 : forall x y, 4 < x -> 0 < y -> ln (x + y) < ln x + y / 4.
  intros x y H H0.
  SearchAbout (exp _ < _).
  apply exp_lt_inv.
  rewrite exp_plus.
  repeat rewrite exp_ln; [ | lra | lra].
  assert (H1 : 0 < y / 4) by lra.
  generalize (exp_ineq1 (y/4) H1); intros; nra.
Qed.

Theorem master_simple : forall f, monotone f -> (* Monotonicity can be relaxed, it's just a bit annoying,
                                                 as C would have to be a max over f n for n in [0..5] *)
                                  ValRel (Tu <n> :== Tu (<n> </> 2) <+> (Td (<n> </> 2)) <+> 1) f ->
                                  f ∈O (fun n => IZR n * ln (IZR n)).
Proof.
  unfold ValRel; simpl; intros f f_mon f_val.
  (* The choice of constants here is pretty darn subtle. *)
  pose (C := Rmax 1 (2 * (f 5%Z) + 1)).
  assert (C_gt_1 : 1 <= C) by (unfold C; apply Rmax_l).
  assert (C_pos : 0 <= C) by lra.
  assert (C_gt_2 : 2 * f 5%Z + 1 <= C) by (unfold C; apply Rmax_r).
  o_of_n_bounds 4%Z C.
  intros M lt.
  SearchAbout (IZR _ <= _ -> _).
  generalize (le_IZR _ _ lt).
  Check Wf_Z.Zlt_lower_bound_rec.
  pattern M.
  eapply Wf_Z.Zlt_lower_bound_rec with (z := 4%Z); [| apply le_IZR; now auto].
  intros x IH lt_x _.
  replace x with (up (IZR x)) by (apply eq_up_IZR).
  eapply Rle_trans; [now (apply f_val) | rewrite eq_up_IZR].
  SearchAbout ((_ <= _)%Z \/ _).
  case (Z.le_gt_cases x 8); intros.
  - SearchAbout (_ -> IZR _ <= IZR _).
    (* This is very tedious!!! *)
    assert (IZR x <= 8) by (apply IZR_le; auto).
    assert (IZR x / 2 <= 4) by lra.
    generalize (down_fund (IZR x / 2)); intros [Hd1 Hd2].
    generalize (up_fund (IZR x / 2)); intros [Hu1 Hu2].
    assert (up (IZR x / 2) <= 5)%Z by (apply le_IZR; lra).
    assert (down (IZR x / 2) <= 5)%Z by (apply le_IZR; lra).
    assert (4 <= IZR x) by (apply IZR_le; auto).
    SearchAbout (_ < ln _).
    Check ln_lt_2.
    assert (/2 <= ln (IZR x))
      by (generalize (Rlt_le _ _ ln_lt_2); intro H5;
          eapply Rle_trans; [exact H5| apply monotone_ln; lra]).
    SearchAbout (_ -> _ * _ <= _ * _).
    assert (C * (2 * / 2) <= C * (IZR x * ln (IZR x))) by
        (apply Rmult_le_compat_l; [now (apply C_pos)  | nra]).
    Check Rle_trans.
    eapply Rle_trans; [| exact H6].
    replace (C * (2 * / 2)) with C by lra.
    (* TODO: FIX THIS *)
    assert (2 * (f 5%Z) + 1 <= C) by (auto).
    eapply Rle_trans; [| exact H7].
    SearchAbout (_ -> _ + _ <= _).
    apply Rplus_le_compat_r.
    assert (f (up (IZR x / 2)) + f (down (IZR x / 2)) <= f 5%Z + f 5%Z) by
    (apply Rplus_le_compat; apply f_mon; apply le_IZR; lra).
    lra.
  - pose (U := up (IZR x / 2)).
    replace (up (IZR x / 2)) with U in |- * by auto.
    assert (f U <= C * (IZR U * ln (IZR U))).
    + apply IH.
      -- split.
         (* TODO: some refactoring *)
         ++ generalize (up_fund (IZR x / 2)); intros [H1 H2].
            subst U.
            apply le_IZR.
            assert (8 < (IZR x)) by (apply IZR_lt; lia).
            lra.
         ++ generalize (up_fund (IZR x / 2)); intros [H1 H2].
            subst U.
            apply lt_IZR.
            assert (8 < (IZR x)) by (apply IZR_lt; lia).
            lra.
      -- generalize (up_fund (IZR x / 2)); intros [H1 H2].
            subst U.
            apply le_IZR.
            assert (8 < (IZR x)) by (apply IZR_lt; lia).
            lra.
    + pose (D := down (IZR x / 2)).
    replace (down (IZR x / 2)) with D in |- * by auto.
    assert (f D <= C * (IZR D * ln (IZR D))).
      -- apply IH.
         (* generalize (down_fund (IZR x / 2)); intros [H1 H2]. *)
         assert (9 <= x)%Z by lia.
         split; subst D.
         ++ SearchAbout (_ \/ _ \/ _).
            generalize (Z.lt_trichotomy x 10).
            intro tri; destruct tri.
            { assert (x = 9%Z) by lia.
              subst x.
              replace 9%Z with (8 + 1)%Z by auto.
              rewrite plus_IZR.
              SearchAbout ((_ + _) / _).
              rewrite Rdiv_plus_distr.
              replace (8/2) with 4 by lra.
              SearchAbout (down (IZR _ + _)).
              rewrite eq_down_add.
              assert (0 <= down (1 / 2))%Z by (apply down_pos; lra).
              lia. }
            { assert (10 <= IZR x) by (apply IZR_le; lia).
              generalize (down_fund (IZR x / 2)); intros [H4 H5].
              apply le_IZR.
              lra. }
         ++ apply lt_IZR.
            assert (9 <= IZR x) by (apply IZR_le; auto).
            generalize (down_fund (IZR x / 2)); intros; lra.
         ++ assert (9 <= x)%Z by lia.
            subst D.
            generalize (Z.lt_trichotomy x 10).
            intro tri; destruct tri.
            { assert (x = 9%Z) by lia.
              subst x.
              replace 9%Z with (8 + 1)%Z by auto.
              rewrite plus_IZR.
              rewrite Rdiv_plus_distr.
              replace (8/2) with 4 by lra.
              rewrite eq_down_add.
              assert (0 <= down (1 / 2))%Z by (apply down_pos; lra).
              lia. }
            { assert (10 <= IZR x) by (apply IZR_le; lia).
              generalize (down_fund (IZR x / 2)); intros [H4 H5].
              apply le_IZR.
              lra. }
      -- apply Rle_trans with (r2 := (C * (IZR U * ln (IZR U))) + (C * (IZR D * ln (IZR D))) + 1); [nra | ].
         assert (8 < IZR x) by (apply IZR_lt; auto).
         assert (0 < IZR D) by (unfold D; generalize (down_fund (IZR x / 2)); intros [H3 H4]; lra).
         assert (0 < IZR U) by (unfold U; generalize (up_fund (IZR x / 2)); intros [H4 H5]; lra).
         assert (C * (IZR D * ln (IZR D)) <= C * (IZR D * ln (IZR U))).
         ++ apply Rmult_le_compat_l; [apply C_pos|].
            apply Rmult_le_compat_l; [apply IZR_le; apply down_pos; lra |].
            apply monotone_ln; [now auto| now auto | apply down_leq_up; lra].
         ++ apply Rle_trans with (r2 := (C * (IZR U * ln (IZR U))) + (C * (IZR D * ln (IZR U))) + 1); [nra | ].
            SearchAbout (_ * (_ + _)).
            rewrite <- Rmult_plus_distr_l.
            rewrite <- Rmult_plus_distr_r.
            rewrite <- plus_IZR.
            SearchAbout (_ + _ = _ + _)%Z.
            rewrite Z.add_comm.
            unfold U, D.
            (* Freaking finally! *)
            rewrite up_down_half.
            assert (ln (IZR (up (IZR x / 2))) <= ln (IZR x / 2) + 1/4).
            { apply Rle_trans with (r2 := ln ((IZR x / 2) + 1)).
              - apply monotone_ln; [now auto| lra |].
                generalize (up_fund (IZR x / 2)); intros; lra.
              - apply Rlt_le.
                apply ln_plus_gt4; lra.
            }
            apply Rle_trans with (r2 := C * (IZR x * (ln (IZR x / 2) + 1/4)) + 1).
            apply Rplus_le_compat.
            { apply Rmult_le_compat_l; [apply C_pos|].
              apply Rmult_le_compat_l; [lra| auto].
            }
            { lra. }
            ring_simplify.
            SearchAbout (ln (_ * _)).
            unfold Rdiv.
            rewrite ln_mult; [| lra | lra].
            SearchAbout (ln (/_)).
            rewrite ln_Rinv; [|lra].
            ring_simplify.
            assert (- C * IZR x * ln 2 + C * IZR x * / 4 + 1 <= 0).
            {
              replace 1 with (/ IZR x * IZR x); [| apply Rinv_l; lra].
              replace (C * IZR x * / 4) with (C * /4 * IZR x) by ring.
              replace (- C * IZR x * ln 2) with (- C * ln 2 * IZR x) by ring.
              repeat rewrite <- Rmult_plus_distr_r.
              assert (/ IZR x < / 8) by (apply Rinv_1_lt_contravar; lra).
              apply Rle_trans with (r2 := (- C * ln 2 + C * / 4 + / 8) * IZR x); [nra | ].
              replace 0 with (0 * IZR x) by ring.
              apply Rmult_le_compat_r; [lra|].
              apply Rle_trans with (r2 := - C * / 2 + C * / 4 + / 8); [generalize ln_lt_2, C_pos; intros; nra|].
              assert (1 <= C) by auto.
              lra.
            }
            lra.
Qed.

Theorem O_pow : forall n m, (n <= m)%nat -> (fun k => (IZR k)^n) ∈O (fun k => (IZR k)^m).
Proof.
  fail.
Qed.

SearchAbout (_^R_).

Lemma baby_master_theorem_1 : forall g f a n,
    n < Nat.log2 a ->
    ValRel (T <n> :== a <*> (T (<n> </> 2)) <+> (g <@> <n>)) f
    -> g ∈O (fun k => k ^ n)
    -> f ∈O (fun k => k ^ (Nat.log2_up a)).
Proof.

Admitted.

(* We can define this! *)
Variable log : R -> R -> R.

(* To express this, we need a log_b a function and a log_b_up one! *)
Theorem master_theorem_1 : forall g f a b n,
    n < log b a ->
    ValRel (T <n> :== a <*> (T (<n> </> b)) <+> (g <@> <n>)) f
    -> g ∈O (fun k => k ^ n)
    -> f ∈O (fun k => k ^ (log b a)).
Proof.
Admitted.