(** This module defines the language algebra without the constant 1, and its finite complete axiomatization.*)

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Require Import tools language.

Delimit Scope one_scope with one.
Open Scope one_scope.

Section s.
  (** * Main definitions *)
  Variable X : Set.
  Variable dec_X : decidable_set X.

  (** [𝐄' X] is the type of expressions with variables ranging over the
  type [X]. They are built out of the constant [0], the
  concatenation (also called sequential product) [⋅], the intersection
  [∩], the union [+], the mirror image, denoted by the postfix
  operator [̅], and the non-zero iteration, denoted by [⁺]. *)
  Inductive 𝐄' : Set :=
  | 𝐄'_zero : 𝐄'
  | 𝐄'_var : X -> 𝐄'
  | 𝐄'_seq : 𝐄' -> 𝐄' -> 𝐄'
  | 𝐄'_inter : 𝐄' -> 𝐄' -> 𝐄'
  | 𝐄'_plus : 𝐄' -> 𝐄' -> 𝐄'
  | 𝐄'_conv : 𝐄' -> 𝐄'
  | 𝐄'_iter : 𝐄' -> 𝐄'.

  Notation "x ⋅ y" := (𝐄'_seq x y) (at level 40) : one_scope.
  Notation "x + y" := (𝐄'_plus x y) (left associativity, at level 50) : one_scope.
  Notation "x ∩ y" := (𝐄'_inter x y) (at level 45) : one_scope.
  Notation "x ¯" := (𝐄'_conv x) (at level 25) : one_scope.
  Notation "x ⁺" := (𝐄'_iter x) (at level 25) : one_scope.
  Notation " 0 " := 𝐄'_zero : one_scope.

  (** The following are the axioms of the algebra of languages over
  this signature.*)
  Inductive ax : 𝐄' -> 𝐄' -> Prop :=
  (** [⟨𝐄',⋅,1⟩] is a monoid. *)
  | ax_seq_assoc e f g : ax (e⋅(f ⋅ g)) ((e⋅f)⋅g)
  (** [⟨𝐄',+,0⟩] is a commutative idempotent monoid. *)
  | ax_plus_com e f : ax (e+f) (f+e)
  | ax_plus_idem e : ax (e+e) e
  | ax_plus_ass e f g : ax (e+(f+g)) ((e+f)+g)
  | ax_plus_0 e : ax (e+0) e
  (** [⟨𝐄',⋅,+,1,0⟩] is an idempotent semiring. *)
  | ax_seq_0 e : ax (e⋅0) 0
  | ax_0_seq e : ax (0⋅e) 0
  | ax_plus_seq e f g: ax ((e + f)⋅g) (e⋅g + f⋅g)
  | ax_seq_plus e f g: ax (e⋅(f + g)) (e⋅f + e⋅g)
  (** [⟨𝐄',∩⟩] is a commutative and idempotent semigroup. *)
  | ax_inter_assoc e f g : ax (e∩(f ∩ g)) ((e∩f)∩g)
  | ax_inter_comm e f : ax (e∩f) (f∩e)
  | ax_inter_idem e : ax (e ∩ e) e
  (** [⟨𝐄',+,∩⟩] forms a distributive lattice, and [0] is absorbing for
  [∩]. *)
  | ax_plus_inter e f g: ax ((e + f)∩g) (e∩g + f∩g)
  | ax_inter_plus e f : ax ((e∩f)+e) e
  | ax_inter_0 e : ax (e∩0) 0
  (** [¯] is an involution that flips concatenations and commutes with
  every other operation. *)
  | ax_conv_conv e : ax (e ¯¯) e
  | ax_conv_0 : ax (0¯) 0
  | ax_conv_plus e f: ax ((e + f)¯) (e ¯ + f ¯)
  | ax_conv_seq e f: ax ((e ⋅ f)¯) (f ¯ ⋅ e ¯)
  | ax_conv_inter e f: ax ((e∩f)¯) (e ¯ ∩ f ¯)
  | ax_conv_iter e : ax (e⁺¯) (e ¯⁺)
  (** The axioms for [⁺] are as follow: *)
  | ax_iter_left e : ax (e⁺) (e + e⋅e⁺)
  | ax_iter_right e : ax (e⁺) (e + e⁺ ⋅e).

  (** Additionally, we need these two implications: *)
  Inductive ax_impl : 𝐄' -> 𝐄' -> 𝐄' -> 𝐄' -> Prop:=
  | ax_right_ind e f : ax_impl (e⋅f + f) f (e⁺⋅f + f) f
  | ax_left_ind e f : ax_impl (f ⋅ e + f) f (f ⋅e⁺ + f) f.

  (** We use these axioms to generate an axiomatic equivalence
  relation and an axiomatic order relations. *)
  Inductive 𝐄'_eq : Equiv 𝐄' :=
  | eq_refl e : e ≡ e
  | eq_trans f e g : e ≡ f -> f ≡ g -> e ≡ g
  | eq_sym e f : e ≡ f -> f ≡ e
  | eq_plus e f g h : e ≡ g -> f ≡ h -> (e + f) ≡ (g + h)
  | eq_seq e f g h : e ≡ g -> f ≡ h -> (e ⋅ f) ≡ (g ⋅ h)
  | eq_inter e f g h : e ≡ g -> f ≡ h -> (e ∩ f) ≡ (g ∩ h)
  | eq_conv e f : e ≡ f -> (e ¯) ≡ (f ¯)
  | eq_iter e f : e ≡ f -> (e⁺) ≡ (f⁺)
  | eq_ax e f : ax e f -> e ≡ f
  | eq_ax_impl e f g h : ax_impl e f g h -> e ≡ f -> g ≡ h.
  Global Instance 𝐄'_Equiv : Equiv 𝐄' := 𝐄'_eq.

  Global Instance 𝐄'_Smaller : Smaller 𝐄' := (fun e f => e + f ≡ f).

  Hint Constructors 𝐄'_eq ax ax_impl.

  Global Instance ax_equiv : subrelation ax equiv.
  Proof. intros e f E;apply eq_ax,E. Qed.

  (** * Some elementary properties of this algebra *)

  (** It is immediate to check that the equivalence we defined is
  indeed an equivalence relation, that the order relation is a
  preorder, and that every operator is monotone for both relations. *)
  Global Instance equiv_Equivalence : Equivalence equiv.
  Proof. split;intro;eauto. Qed.

  Global Instance inter_equiv :
    Proper (equiv ==> equiv ==> equiv) 𝐄'_inter.
  Proof. now intros e f hef g h hgh;apply eq_inter. Qed.

  Global Instance plus_equiv :
    Proper (equiv ==> equiv ==> equiv) 𝐄'_plus.
  Proof. now intros e f hef g h hgh;apply eq_plus. Qed.

  Global Instance seq_equiv :
    Proper (equiv ==> equiv ==> equiv) 𝐄'_seq.
  Proof. now intros e f hef g h hgh;apply eq_seq. Qed.

  Global Instance conv_equiv :
    Proper (equiv ==> equiv) 𝐄'_conv.
  Proof. now intros e f hef;apply eq_conv. Qed.

  Global Instance iter_equiv :
    Proper (equiv ==> equiv) 𝐄'_iter.
  Proof. now intros e f hef;apply eq_iter. Qed.

  Global Instance smaller_PreOrder : PreOrder smaller.
  Proof.
    split;intro;unfold smaller,𝐄'_Smaller;intros.
    - auto.
    - transitivity (y + z);[|auto].
      transitivity (x + y + z);[|auto].
      transitivity (x + (y + z));[|auto].
      auto.
  Qed.

  Global Instance smaller_PartialOrder : PartialOrder equiv smaller.
  Proof.
    intros e f;split;unfold smaller,𝐄'_Smaller;unfold Basics.flip.
    - intros E;split.
      + rewrite E;auto.
      + rewrite E;auto.
    - intros (E1&E2).
      rewrite <- E1.
      rewrite <- E2 at 1;auto.
  Qed.

  Global Instance smaller_equiv : subrelation equiv smaller.
  Proof. intros e f E;apply smaller_PartialOrder in E as (E&_);apply E. Qed.
End s.
(* begin hide *)
Arguments 𝐄'_zero {X}.
Hint Constructors 𝐄'_eq ax ax_impl.
(* end hide *)
Infix " ⋅ " := 𝐄'_seq (at level 40) : one_scope.
Infix " + " := 𝐄'_plus (left associativity, at level 50) : one_scope.
Infix " ∩ " := 𝐄'_inter (at level 45) : one_scope.
Notation "x ¯" := (𝐄'_conv x) (at level 25) : one_scope.
Notation "x ⁺" := (𝐄'_iter x) (at level 25) : one_scope.
Notation " 0 " := 𝐄'_zero : one_scope.

Section language.
  (** * Language interpretation *)
  Context { X : Set }.

  (** We interpret expressions as languages in the obvious way: *)
  Global Instance to_lang_𝐄' {Σ}: semantics 𝐄' language X Σ :=
    fix to_lang_𝐄' σ e:=
      match e with
      | 0 => 0%lang
      | 𝐄'_var a => (σ a)
      | e + f => ((to_lang_𝐄' σ e) + (to_lang_𝐄' σ f))%lang
      | e ⋅ f => ((to_lang_𝐄' σ e) ⋅ (to_lang_𝐄' σ f))%lang
      | e ∩ f => ((to_lang_𝐄' σ e) ∩ (to_lang_𝐄' σ f))%lang
      | e ¯ => (to_lang_𝐄' σ e)¯%lang
      | e⁺ => (to_lang_𝐄' σ e)⁺%lang
      end.

  (* begin hide *)
  Global Instance semSmaller_𝐄' : SemSmaller (𝐄' X) :=
    (@semantic_containment _ _ _ _ _).
  Global Instance semEquiv_𝐄' : SemEquiv (𝐄' X) :=
    (@semantic_equality _ _ _ _ _).
  Hint Unfold semSmaller_𝐄' semEquiv_𝐄' : semantics.

  Section rsimpl.
    Context { Σ : Set }{σ : 𝕬[X→Σ] }.
    Lemma 𝐄'_union e f : (⟦ e+f ⟧σ) = ((⟦e⟧σ) + ⟦f⟧σ)%lang.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_prod e f :  (⟦ e⋅f ⟧σ) = ((⟦e⟧σ) ⋅ ⟦f⟧σ)%lang.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_intersection e f : (⟦ e∩f ⟧σ) = ((⟦e⟧σ) ∩ ⟦f⟧σ)%lang.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_mirror e :  (⟦ e ¯⟧σ) = (⟦e⟧σ)¯%lang.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_iter_l e :  (⟦ e⁺⟧σ) = (⟦e⟧σ)⁺%lang.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_variable a : (⟦𝐄'_var a⟧ σ) = σ a.
    Proof. unfold interprete;simpl;auto. Qed.
    Lemma 𝐄'_empty : (⟦0⟧σ) = 0%lang.
    Proof. unfold interprete;simpl;auto. Qed.
  End rsimpl.
  Hint Rewrite @𝐄'_empty @𝐄'_variable @𝐄'_intersection
       @𝐄'_prod @𝐄'_union @𝐄'_mirror @𝐄'_iter_l
    : simpl_typeclasses.

  Global Instance sem_incl_𝐄'_plus :
    Proper (ssmaller ==> ssmaller ==> ssmaller) (@𝐄'_plus X).
  Proof.
    intros e f E g h F ? ?;simpl;rsimpl;revert E F;
      repeat autounfold with semantics;firstorder.
  Qed.
  Global Instance sem_incl_𝐄'_fois :
    Proper (ssmaller ==> ssmaller ==> ssmaller) (@𝐄'_seq X).
  Proof.
    intros e f E g h F Σ σ;simpl;revert E F;rsimpl;
      repeat autounfold with semantics;firstorder.
  Qed.
  Global Instance sem_incl_𝐄'_inter :
    Proper (ssmaller ==> ssmaller ==> ssmaller) (@𝐄'_inter X).
  Proof.
    intros e f E g h F Σ σ;simpl;revert E F;rsimpl;
      repeat autounfold with semantics;firstorder.
  Qed.
  Global Instance sem_incl_𝐄'_conv :
    Proper (ssmaller ==> ssmaller) (@𝐄'_conv X).
  Proof.
    intros e f E Σ σ;simpl;revert E;rsimpl;
      repeat autounfold with semantics;firstorder.
  Qed.
  Global Instance sem_incl_𝐄'_iter :
    Proper (ssmaller ==> ssmaller) (@𝐄'_iter X).
  Proof.
    intros e f E Σ σ;simpl.
    autorewrite with simpl_typeclasses.
    apply iter_lang_incl,E.
  Qed.
  Global Instance sem_eq_𝐄'_plus :
    Proper (sequiv ==> sequiv ==> sequiv) (@𝐄'_plus X).
  Proof. eapply (@sem_eq_op _ _ ssmaller);once (typeclasses eauto). Qed.
  Global Instance sem_eq_𝐄'_seq :
    Proper (sequiv ==> sequiv ==> sequiv) (@𝐄'_seq X).
  Proof. eapply (@sem_eq_op _ _ ssmaller);once (typeclasses eauto). Qed.
  Global Instance sem_eq_𝐄'_inter :
    Proper (sequiv ==> sequiv ==> sequiv) (@𝐄'_inter X).
  Proof. eapply (@sem_eq_op _ _ ssmaller);once (typeclasses eauto). Qed.
  Global Instance sem_eq_𝐄'_conv :
    Proper (sequiv ==> sequiv) (@𝐄'_conv X).
  Proof.
    intros e f E Σ σ;simpl;autounfold;rsimpl.
    intro w;rewrite (E Σ σ (rev w));tauto.
  Qed.
  Global Instance sem_eq_𝐄'_iter :
    Proper (sequiv ==> sequiv) (@𝐄'_iter X).
  Proof.
    intros e f E Σ σ;simpl.
    autorewrite with simpl_typeclasses.
    apply iter_lang_eq,E.
  Qed.
  Global Instance 𝐄'_sem_equiv :
    Equivalence (fun e f : 𝐄' X => e ≃ f).
  Proof. once (typeclasses eauto). Qed.
  Global Instance 𝐄'_sem_PreOrder :
    PreOrder (fun e f : 𝐄' X => e ≲ f).
  Proof. once (typeclasses eauto). Qed.
  Global Instance 𝐄'_sem_PartialOrder :
    PartialOrder (fun e f : 𝐄' X => e ≃ f)
                 (fun e f : 𝐄' X => e ≲ f).
  Proof.
    eapply semantic_containment_PartialOrder;once (typeclasses eauto).
  Qed.

  (* end hide *)

  Lemma lang_iter_prod_last {Σ}(l: language Σ) n : (l ^{S n} ≃ l ^{n} ⋅ l)%lang.
  Proof.
    induction n.
    - simpl;intros w;split;intros (u&v&I1&I2&->).
      + rewrite I2,app_nil_r;exists [],u;split;reflexivity||auto.
      + rewrite I1;exists v,[];rewrite app_nil_r;repeat split;auto.
    - intros x;split.
      + intros (u&?&I1&I2&->).
        apply IHn in I2 as (v&w&I2&I3&->).
        exists (u++v),w;rewrite app_ass;repeat split;auto.
        exists u,v;tauto.
      + intros (?&w&(u&v&I1&I2&->)&I3&->).
        cut (l^{S n}%lang (v++w));[|apply IHn;exists v,w;tauto].
        intro I';exists u,(v++w);rewrite app_ass;repeat split;auto.
  Qed.

  (** This interpretation is sound in the sense that axiomatically
  equivalent expressions are semantically equivalent. Differently put,
  the axioms we imposed hold in every algebra of languages. *)
  Theorem soundness_𝐄' : forall e f : 𝐄' X, e ≡ f ->  e ≃ f.
  Proof.
    assert (dumb : forall A (w:list A), rev w = nil <-> w = nil)
      by (intros A w;split;[intro h;rewrite <-(rev_involutive w),h
                           |intros ->];reflexivity).
    intros e f E Σ σ;induction E;rsimpl;try firstorder.
    - apply iter_lang_eq,IHE.
    -  destruct H;rsimpl;repeat autounfold with semantics;try (now firstorder).
       + intro w;firstorder.
         * rewrite H1,H3;clear x0 w H1 H3;rewrite<- app_ass.
           eexists;eexists;split;[eexists;eexists;split;[|split]
                                 |split];eauto.
         * rewrite H1,H3;clear x w H1 H3;rewrite app_ass.
           eexists;eexists;split;
             [|split;[eexists;eexists;split;[|split]|]];eauto.
       + intro w;rewrite rev_involutive;tauto.
       + intro w;firstorder.
         * rewrite <- (rev_involutive w),H1,rev_app_distr;eauto.
           exists (rev x0);exists (rev x).
           setoid_rewrite rev_involutive;auto.
         * rewrite H1,rev_app_distr;eauto.
       + intros w;split.
         * intros (n&Iu);exists n.
           generalize dependent (S n);clear n;intros n;revert w.
           induction n;intro w;[simpl;apply dumb|].
           intro I;apply lang_iter_prod_last in I as (u&v&Iu&Iv&E).
           replace w with (rev v++rev u) in * by (now rewrite <- rev_app_distr,<-E,rev_involutive).
           clear w E.
           exists (rev v),(rev u);rewrite rev_involutive.
           repeat split;auto.
           apply IHn;rewrite rev_involutive;assumption.
         * intros (n&Iu);exists n.
           generalize dependent (S n);clear n;intros n;revert w.
           induction n;intro w;[simpl;apply dumb|].
           intro I;apply lang_iter_prod_last in I as (u&v&Iu&Iv&->).
           exists (rev v),(rev u);rewrite rev_app_distr.
           repeat split;auto.
       + intros w;split.
         * intros ([]&Iu).
           -- left;destruct Iu as (u'&?&Iu&->&->).
              rewrite app_nil_r;assumption.
           -- right;destruct Iu as (u&v&Iu&Iv&->).
              exists u,v;repeat split;auto.
              exists n;assumption.
         * intros [Iu|(u&v&Iu&(m&Iv)&->)].
           -- exists 0%nat,w,[];rewrite app_nil_r;repeat split;assumption.
           -- exists (S m),u,v;tauto.
       + intros w;split.
         * intros ([]&Iu).
           -- left;destruct Iu as (u'&?&Iu&->&->).
              rewrite app_nil_r;assumption.
           -- apply lang_iter_prod_last in Iu.
              right;destruct Iu as (u&v&Iu&Iv&->).
              exists u,v;repeat split;auto.
              exists n;assumption.
         * intros [Iu|(u&v&(m&Iu)&Iv&->)].
           -- exists 0%nat,w,[];rewrite app_nil_r;repeat split;assumption.
           -- exists (S m);apply lang_iter_prod_last.
              exists u,v;tauto.
    - destruct H.
      + assert (ih : ⟦e⋅f⟧σ≲⟦f⟧σ) by (intros u Iu;apply (IHE u);left;apply Iu);clear IHE.
        cut (⟦e⁺⋅f⟧σ≲⟦f⟧σ);[intros E u;split;[intros [I|I];[apply E|]|intro;right];assumption|].
        intros w (u&v&(n&Iu)&Iv&->).
        revert u v Iu Iv;induction n;intros u v Iu Iv.
        * destruct Iu as (u'&?&Iu&->&->).
          rewrite app_nil_r;apply ih;exists u',v;tauto.
        * apply lang_iter_prod_last in Iu as (u1&u2&Iu1&Iu2&->);rewrite app_ass.
          apply IHn;[assumption|].
          apply ih;exists u2,v;tauto.
      + assert (ih : ⟦f⋅e⟧σ≲⟦f⟧σ) by (intros u Iu;apply (IHE u);left;apply Iu);clear IHE.
        cut (⟦f⋅e⁺⟧σ≲⟦f⟧σ);[intros E u;split;[intros [I|I];[apply E|]|intro;right];assumption|].
        intros w (u&v&Iu&(n&Iv)&->).
        revert u v Iu Iv;induction n;intros u v Iu Iv.
        * destruct Iv as (v'&?&Iv&->&->).
          rewrite app_nil_r;apply ih;exists u,v';tauto.
        * destruct Iv as (v1&v2&Iv1&Iv2&->);rewrite <- app_ass.
          apply IHn;[|assumption].
          apply ih;exists u,v1;tauto.
  Qed.

  (** This extends to ordering as well. *)
  Lemma soundness_inf_𝐄' (e f : 𝐄' X) : e ≤ f -> e ≲ f.
  Proof.
    intro E;apply smaller_equiv,soundness_𝐄' in E.
    intros Σ σ w I;apply E;rsimpl;left;left;auto.
  Qed.

End language.
Hint Rewrite @𝐄'_empty @𝐄'_variable @𝐄'_intersection
     @𝐄'_prod @𝐄'_union @𝐄'_mirror @𝐄'_iter_l
  : simpl_typeclasses.


(************************************************************************)
(* Copyright (c) 2010, Martijn Vermaat <martijn@vermaat.name>           *)
(*                                                                      *)
(* Licensed under the MIT license, see the LICENSE file or              *)
(* http://en.wikipedia.org/wiki/Mit_license                             *)
(************************************************************************)

(** This library defines substition of terms for variables in terms. *)

Require Export List.
Require Export FiniteTerm.
Require Export Term.
Require Import TermEquality.
Require Import Equality.

Set Implicit Arguments.

Section Substitution.

Variable F : signature.
Variable X : variables.

Notation term := (term F X).
Notation fterm := (finite_term F X).

(** A substitution is a function from variables to terms. *)
Definition substitution := X -> term.

(** Equality of substitutions on a list of variables. *)
Fixpoint substitution_eq (vars : list X) (sigma sigma' : substitution) :=
  match vars with
  | nil     => True
  | x :: xs => (substitution_eq xs sigma sigma') /\ (sigma x = sigma' x)
  end.

(** Equality of substitutions on a list of variables is invariant under
   list inclusion.

   We have not yet proven this lemma. This taints the lemma [step_eq__target]
   in [Rewriting]. *)
Lemma substitution_eq_incl :
  forall sigma theta l l',
    incl l' l ->
    substitution_eq l sigma theta ->
    substitution_eq l' sigma theta.
Proof.
intros sigma theta l l' H1 H2.
revert l' H1.
induction l as [| x l IH]; intros l' H1; simpl.
destruct l' as [| y l'].
exact I.
elim (H1 y).
left; reflexivity.

induction l' as [| y l' IH']; simpl.
exact I.
split.
apply IH'.
intros z H.
apply H1.
right.
assumption.
destruct (H1 y).
left; reflexivity.
rewrite H in H2.
apply H2.
simpl in H2.
(** This should not be too hard. (Problem is whether [x] is in [l']. *)
Admitted.

Lemma substitution_eq_app_left :
  forall sigma theta l l',
    substitution_eq (l ++ l') sigma theta ->
    substitution_eq l sigma theta.
Proof.
intros sigma theta l l' H.
induction l as [| x l IH]; simpl.
exact I.
split.
apply IH.
apply H.
apply H.
Qed.

Lemma substitution_eq_app_right :
  forall sigma theta l l',
    substitution_eq (l ++ l') sigma theta ->
    substitution_eq l' sigma theta.
Proof.
intros sigma theta l l' H.
induction l as [| x l IH]; simpl.
assumption.
apply IH.
apply H.
Qed.

Implicit Arguments substitution_eq_app_left [l l'].
Implicit Arguments substitution_eq_app_right [l l'].

(** We show [substitution_eq] is an equivalence. *)

Lemma substitution_eq_refl :
  forall vars sigma, substitution_eq vars sigma sigma.
Proof.
induction vars; [simpl | split]; trivial.
Qed.

Lemma substitution_eq_symm :
  forall vars sigma theta,
    substitution_eq vars sigma theta ->
    substitution_eq vars theta sigma.
Proof.
intros vars sigma theta H.
induction vars as [| x vars IH]; simpl.
exact I.
split.
apply IH.
apply H.
symmetry.
apply H.
Qed.

Lemma substitution_eq_trans :
  forall vars sigma theta upsilon,
    substitution_eq vars sigma theta ->
    substitution_eq vars theta upsilon ->
    substitution_eq vars sigma upsilon.
Proof.
intros vars sigma theta upsilon H1 H2.
induction vars as [| x vars IH]; simpl.
exact I.
split.
apply IH.
apply H1.
apply H2.
apply eq_trans with (theta x).
apply H1.
apply H2.
Qed.

(** The identity substitution. *)
Definition empty_substitution (x : X) : term := Var x.

(** We define two substitution functions. The first, [substitute], defines
   substitution on finite terms. The second, [substitute'], defines
   substitution on infinite terms.

   In principle, [substitute'] works fine and is a generalisation of
   [substitute]. However, it yields a (potentially) infinite term (of type
   [term] instead of [finite_term]) and this makes it somewhat painful to
   work with (corecursive definitions have to be manually unfolded in Coq).

   Since we almost always apply substitutions on finite terms, we define
   this seperately and provide the more general [substitute'] for
   completeness. *)

(** Apply a substitution to a finite term. *)
Fixpoint substitute (sigma : substitution) (t : fterm) {struct t} : term :=
  match t with
  | FVar x      => sigma x
  | FFun f args => Fun f (vmap (substitute sigma) args)
  end.

(** Applying the empty substitution to a finite term gives the trivial
   infinite term image. The only reason we cannot prove coq-equality here
   is equality on vectors. *)
Lemma empty_substitution_is_id :
  forall (t : fterm), substitute empty_substitution t [~] t.
Proof.
induction t.
apply term_bis_refl.
constructor.
assumption.
Qed.

(** Applying equal substitutions yields equal terms.

   We have not yet proven this lemma. This taints the lemmas
   [step_eq_source] and [step_eq_target] in [Rewriting]. *)
Lemma substitution_eq_substitute :
  forall sigma theta t,
    substitution_eq (vars t) sigma theta ->
    substitute sigma t [~] substitute theta t.
Proof.
intros sigma theta t H.
induction t as [x | f args IH]; simpl.
rewrite (proj2 H).
apply term_bis_refl.
constructor.
intro i.
apply IH; clear IH.
simpl in H.
unfold vmap in H.
induction (arity f) as [| n IH]; clear f.
inversion i.
dependent destruction i.
simpl in H.
unfold vhead in H.
unfold vtail in H.
apply (substitution_eq_app_left sigma theta H).
specialize IH with (vtail args) i.
apply IH.
unfold vtail.
(** Here we are stuck, need some more lemmas on [vector], for example:

[[
Lemma a :
  forall x n v,
    In x (vfold nil app (fun i0 : Fin n => vars (v (Next i0)))) ->
    In x (vfold nil app (fun i : Fin (S n) => vars (v i))).
]]
*)
Admitted.

(** Apply a substitution to an infinite term. Note that this definition is
   not in guarded form if we were to use the inductive vector type from the
   standard library. It is in guarded form here, because we use [vector]
   from the [Vector] library, where [vmap] is just an abstraction (which
   ensures the corecursive call to [substitute'] to be guarded). *)
CoFixpoint substitute' (sigma : substitution) (t : term) : term :=
  match t with
  | Var x      => sigma x
  | Fun f args => Fun f (vmap (substitute' sigma) args)
  end.

(** Applying the empty substitution to a term gives the same term. *)
Lemma empty_substitution_is_id' :
  forall (t : term), substitute' empty_substitution t [~] t.
Proof.
cofix IH.
destruct t.
rewrite (peek_eq (substitute' empty_substitution (Var v))).
apply term_bis_refl.
rewrite (peek_eq (substitute' empty_substitution (Fun f v))).
simpl.
constructor.
intro i.
unfold vmap.
apply IH.
Qed.

(** We prove that both substitution functions do the same thing (on finite
   terms). We can almost prove this for coq-equality, but we cannot equate
   [vmap finite_term_as_term v] and [v]. *)
Lemma substitutions_related :
  forall (s : substitution) (t : fterm), substitute s t [~] substitute' s t.
Proof.
induction t.
simpl.
rewrite (peek_eq (substitute' s (Var v))).
simpl.
destruct (s v); apply term_bis_refl.
simpl.
rewrite (peek_eq (substitute' s (Fun f (vmap (@finite_term_as_term F X) v)))).
simpl.
constructor.
intro i.
unfold vmap.
apply H.
Qed.

End Substitution.


Definition Is_true (b:bool) :=
  match b with
    | true => True
    | false => False
  end.

Lemma bool_dec : forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}.
Proof.
intros a b.
destruct a;destruct b.
left. reflexivity.
right. discriminate.
right. discriminate.
left. reflexivity.
Show Proof.
Defined.

Lemma diff_true_false : true <> false.
Proof.
discriminate.
Show Proof.
Print False_ind.
Qed.

Lemma diff_false_true : false <> true.
Proof.
  discriminate.
Qed.

Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False.
Proof.
intro b.
intro btrue.
subst b.
intro h.
discriminate.
Show Proof.
Qed.

Lemma not_true_is_false : forall b:bool, b <> true -> b = false.
Proof.
destruct b.
intro h.
apply False_ind.
apply h. reflexivity.
intro b. reflexivity.
Show Proof.
Qed.

Lemma not_false_is_true : forall b:bool, b <> false -> b = true.
Proof.
intro b.
intro h.
unfold not in h.
destruct b.
reflexivity.
apply False_ind.
apply h. reflexivity.
Qed.

Lemma not_true_iff_false : forall b, b <> true <-> b = false.
Proof.
unfold iff. unfold not.
destruct b.
split. intro h. apply False_ind. apply h. apply eq_refl.
intro h. intro eq. discriminate.
split. intro h. reflexivity.
intro h. intro hft. discriminate.
Show Proof.
Qed.

Lemma not_false_iff_true : forall b, b <> false <-> b = true.
Proof.
unfold iff. unfold not.
destruct b;split; intros;try(discriminate);try(reflexivity).
contradiction.
Qed.

Definition leb (b1 b2:bool) :=
  match b1 with
    | true => b2 = true
    | false => True
  end.

Lemma leb_implb : forall b1 b2, leb b1 b2 <-> implb b1 b2 = true.
Proof.
unfold implb. unfold leb. unfold iff.
intros a b ; destruct a;destruct b;split;try(reflexivity);try(intro;discriminate).
Qed.

Definition eqb (b1 b2:bool) : bool :=
  match b1, b2 with
    | true, true => true
    | true, false => false
    | false, true => false
    | false, false => true
  end.

Lemma eqb_subst :
  forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2.
Proof.
unfold eqb. intros P a b.
destruct a;destruct b;intros heq pb;try(assumption);try(discriminate).
Qed.

Lemma eqb_reflx : forall b:bool, eqb b b = true.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b.
Proof.
intros a b. unfold eqb. destruct a;destruct b;try(reflexivity);intros;try(assumption);try(symmetry;assumption).
Qed.

Lemma eqb_true_iff : forall a b:bool, eqb a b = true <-> a = b.
Proof.
unfold iff. unfold eqb.
intros a b.
destruct a;destruct b;split;intros;try(reflexivity);try(assumption);try(symmetry;assumption).
Qed.

Lemma eqb_false_iff : forall a b:bool, eqb a b = false <-> a <> b.
Proof.
unfold eqb. unfold not.
unfold iff.
intros a b;destruct a;destruct b;split;intros;try(discriminate);try(reflexivity);try(contradiction).
Qed.

Definition ifb (b1 b2 b3:bool) : bool :=
  match b1 with
    | true => b2
    | false => b3
  end.

(****************************)
(** * De Morgan laws          *)
(****************************)

Lemma negb_orb : forall b1 b2:bool, negb (orb b1 b2) = (andb (negb b1) (negb b2)).
Proof.
intros a b.
unfold negb. unfold orb. unfold andb.
destruct a;destruct b;reflexivity.
Qed.

Lemma negb_andb : forall b1 b2:bool, negb (andb b1 b2) = orb (negb b1) (negb b2).
Proof.
unfold negb. unfold andb. unfold orb.
intros a b;destruct a;destruct b;reflexivity.
Show Proof.
Qed.

Lemma negb_involutive : forall b:bool, negb (negb b) = b.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma negb_involutive_reverse : forall b:bool, b = negb (negb b).
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma negb_sym : forall b b':bool, b' = negb b -> b = negb b'.
Proof.
intros a b;unfold negb;destruct a;destruct b;intros;try(assumption);reflexivity.
Qed.

Lemma no_fixpoint_negb : forall b:bool, negb b <> b.
Proof.
intro b;unfold negb;unfold not;intros;destruct b;discriminate.
Qed.

Lemma eqb_negb1 : forall b:bool, eqb (negb b) b = false.
Proof.
intro b;unfold eqb;unfold negb;destruct b;reflexivity.
Qed.

Lemma eqb_negb2 : forall b:bool, eqb b (negb b) = false.
Proof.
unfold eqb;unfold negb;intro b;destruct b;reflexivity.
Qed.

Lemma if_negb :
  forall (A:Type) (b:bool) (x y:A),
    (if negb b then x else y) = (if b then y else x).
Proof.
intros A b x y.
unfold negb.
destruct b;reflexivity.
Qed.

Lemma negb_true_iff : forall b, negb b = true <-> b = false.
Proof.
intro b;unfold iff;unfold negb.
destruct b;split;intros;try(symmetry;assumption);try(reflexivity).
Qed.

Lemma negb_false_iff : forall b, negb b = false <-> b = true.
Proof.
unfold iff;unfold negb.
intro b;destruct b;split;intros;try(reflexivity);try(symmetry;assumption).
Qed.

Lemma orb_true_iff :
  forall b1 b2, orb b1 b2 = true <-> b1 = true \/ b2 = true.
Proof.
unfold iff;unfold orb.
intros a b;destruct a;destruct b;split;intros;try(reflexivity);try(right;reflexivity);try(left;reflexivity);try(right;assumption).
inversion H;assumption.
Qed.

Lemma orb_false_iff :
  forall b1 b2, orb b1 b2 = false <-> b1 = false /\ b2 = false.
Proof.
unfold iff. unfold orb.
intros a b;destruct a;destruct b;split;intros;try(split);try(assumption);try(reflexivity).
inversion H;assumption.
inversion H;try(discriminate).
inversion H;try(discriminate).
Qed.

Lemma orb_true_elim :
  forall b1 b2:bool, (orb b1 b2) = true -> {b1 = true} + {b2 = true}.
Proof.
intros a b.
unfold orb.
destruct a;destruct b;intros;try(left;reflexivity);try(right;reflexivity);try(right;assumption).
Defined.

Lemma orb_prop : forall a b:bool, (orb a b) = true -> a = true \/ b = true.
Proof.
unfold orb.
intros a b;destruct a;destruct b;intros;try(right;reflexivity);try(left;reflexivity).
left;assumption.
Qed.

Lemma orb_true_intro :
  forall b1 b2:bool, b1 = true \/ b2 = true -> orb b1 b2 = true.
Proof.
unfold orb.
intros a b;destruct a;destruct b;intros;try(reflexivity).
inversion H;assumption.
Qed.

Lemma orb_false_intro :
  forall b1 b2:bool, b1 = false -> b2 = false -> orb b1 b2 = false.
Proof.
unfold orb.
intros a b;destruct a;destruct b;intros;try(reflexivity);try(assumption).
Qed.

Lemma orb_false_elim :
  forall b1 b2:bool, orb b1 b2 = false -> b1 = false /\ b2 = false.
Proof.
unfold orb.
intros a b;destruct a;destruct b;intros;split;try(reflexivity);try(assumption).
Qed.

Lemma orb_diag : forall b, orb b b = b.
Proof.
destruct b;reflexivity.
Qed.

Lemma orb_true_r : forall b:bool, orb b true = true.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma orb_true_l : forall b:bool, orb true b = true.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma orb_false_r : forall b:bool, orb b false = b.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma orb_false_l : forall b:bool, orb false b = b.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma orb_negb_r : forall b:bool, orb b (negb b) = true.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma orb_comm : forall b1 b2:bool, orb b1 b2 = orb b2 b1.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma orb_assoc : forall b1 b2 b3:bool, orb b1 (orb b2 b3) = orb (orb b1 b2) b3.
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma andb_true_iff :
  forall b1 b2:bool, andb b1 b2 = true <-> b1 = true /\ b2 = true.
Proof.
unfold iff,andb.
intros a b;destruct a;destruct b;split;intros;try(split);try(reflexivity);try(assumption).
inversion H;discriminate.
inversion H;discriminate.
inversion H;assumption.
Qed.

Lemma andb_false_iff :
  forall b1 b2:bool, andb b1 b2 = false <-> b1 = false \/ b2 = false.
Proof.
unfold iff, andb.
intros a b;destruct a;destruct b;split;intros;try(left;assumption);try(right;assumption);try(reflexivity).
inversion H;assumption.
Qed.

Lemma andb_true_eq :
  forall a b:bool, true = andb a b -> true = a /\ true = b.
Proof.
unfold andb.
intros a b;destruct a;destruct b;intros;split;try(reflexivity);try(assumption).
Defined.

Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false ->andb b1  b2 = false.
Proof.
unfold andb.
intros a b;destruct a;destruct b;intros;try(reflexivity);assumption.
Qed.

Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> andb b1 b2 = false.
Proof.
unfold andb.
intros a b;destruct a;destruct b;intros;try(reflexivity);try(assumption).
Qed.

Lemma andb_false_r : forall b:bool, andb b false = false.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma andb_false_l : forall b:bool, andb false b = false.
Proof.
intro b. simpl. reflexivity.
Qed.

Lemma andb_diag : forall b, andb b b = b.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma andb_true_r : forall b:bool, andb b true = b.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma andb_true_l : forall b:bool, andb true b = b.
Proof.
simpl. reflexivity.
Qed.

Lemma andb_false_elim :
  forall b1 b2:bool, andb b1 b2 = false -> {b1 = false} + {b2 = false}.
Proof.
unfold andb.
intros a b;destruct a;destruct b;intros;try(discriminate);try(left;reflexivity).
right;reflexivity.
Defined.

Lemma andb_negb_r : forall b:bool, andb b (negb b) = false.
Proof.
intro b;destruct b;reflexivity.
Qed.

Lemma andb_comm : forall b1 b2:bool, andb b1 b2 = andb b2 b1.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma andb_assoc : forall b1 b2 b3:bool, andb b1 (andb b2 b3) = andb (andb b1 b2) b3.
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

(*******************************************)
(** * Properties mixing [andb] and [orb] *)
(*******************************************)

(** Distributivity *)

Lemma andb_orb_distrib_r :
  forall b1 b2 b3:bool, andb b1 (orb b2 b3) = orb (andb b1 b2) (andb b1 b3).
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma andb_orb_distrib_l :
 forall b1 b2 b3:bool, andb (orb b1 b2) b3 = orb (andb b1 b3) (andb b2 b3).
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma orb_andb_distrib_r :
  forall b1 b2 b3:bool, orb b1 (andb b2 b3) = andb (orb b1 b2) (orb b1 b3).
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma orb_andb_distrib_l :
  forall b1 b2 b3:bool, orb (andb b1 b2) b3 = andb (orb b1 b3) (orb b2 b3).
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma absorption_andb : forall b1 b2:bool, andb b1 (orb b1 b2) = b1.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma absorption_orb : forall b1 b2:bool, orb b1 (andb b1 b2) = b1.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma xorb_false_r : forall b:bool, xorb b false = b.
Proof.
intros a;destruct a;reflexivity.
Qed.

Lemma xorb_false_l : forall b:bool, xorb false b = b.
Proof.
intros a;destruct a;reflexivity.
Qed.

Lemma xorb_true_r : forall b:bool, xorb b true = negb b.
Proof.
intros a;destruct a;reflexivity.
Qed.

Lemma xorb_true_l : forall b:bool, xorb true b = negb b.
Proof.
intros a;destruct a;reflexivity.
Qed.

Lemma xorb_nilpotent : forall b:bool, xorb b b = false.
Proof.
intros a;destruct a;reflexivity.
Qed.

(** Commutativity *)

Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma xorb_assoc_reverse :
  forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b'').
Proof.
intros a b c;destruct a;destruct b;destruct c;reflexivity.
Qed.

Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'.
Proof.
intros a b;destruct a;destruct b;simpl;intros;try(reflexivity);try(assumption).
symmetry;assumption.
Qed.

Lemma xorb_move_l_r_1 :
  forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''.
Proof.
intros a b c.
destruct a;destruct b;destruct c;simpl;intros;try(reflexivity);try(assumption);symmetry;assumption.
Qed.

Lemma xorb_move_l_r_2 :
  forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'.
Proof.
intros a b c;destruct a;destruct b;destruct c;simpl;intros;
try(reflexivity);try(assumption);symmetry;assumption.
Qed.

Lemma xorb_move_r_l_1 :
  forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''.
Proof.
intros a b c;destruct a;destruct b;destruct c;simpl;intros;
try(reflexivity);try(assumption);symmetry;assumption.
Qed.

Lemma xorb_move_r_l_2 :
  forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'.
Proof.
intros a b c;destruct a;destruct b;destruct c;simpl;intros;
try(reflexivity);try(assumption);symmetry;assumption.
Qed.

Lemma negb_xorb_l : forall b b', negb (xorb b b') = xorb (negb b) b'.
Proof.
intros a b;destruct a;destruct b;simpl;reflexivity.
Qed.

Lemma negb_xorb_r : forall b b', negb (xorb b b') = xorb b (negb b').
Proof.
intros a b;destruct a;destruct b;simpl;reflexivity.
Qed.

Lemma xorb_negb_negb : forall b b', xorb (negb b) (negb b') = xorb b b'.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma eq_iff_eq_true : forall b1 b2, b1 = b2 <-> (b1 = true <-> b2 = true).
Proof.
intros a b;destruct a;destruct b;split;try(split);intros;
try(reflexivity);try(discriminate).
inversion H. symmetry. apply H0. reflexivity.
inversion H. apply H1. reflexivity.
Qed.

Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2.
Proof.
intros a b h.
inversion h as [l r].
destruct a;destruct b;try(reflexivity).
symmetry;apply l;reflexivity.
apply r;reflexivity.
Qed.

Lemma eq_true_negb_classical : forall b:bool, negb b <> true -> b = true.
Proof.
intros b hn.
destruct b;try(reflexivity).
simpl in hn. contradiction.
Qed.

Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true.
Proof.
intros b h.
destruct b;simpl;try(reflexivity).
contradiction.
Qed.

Lemma absurd_eq_bool : forall b b':bool, False -> b = b'.
Proof.
intros a b.
intro h.
contradiction.
Qed.

Lemma absurd_eq_true : forall b, False -> b = true.
Proof.
intros b F.
contradiction.
Qed.

Lemma trans_eq_bool : forall x y z:bool, x = y -> y = z -> x = z.
Proof.
intros x y z.
intros eqxy eqyz.
subst z. subst x. reflexivity.
Qed.

Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true.
Proof.
intros b h.
unfold Is_true in h.
destruct b;try(reflexivity).
contradiction.
Qed.

Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x.
Proof.
unfold Is_true.
intros b h.
subst b.
apply I.
Qed.

Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x.
Proof.
unfold Is_true.
intros b heq.
subst b.
apply I.
Qed.

Lemma eqb_refl : forall x:bool, Is_true (eqb x x).
Proof.
unfold Is_true.
intro b.
destruct b;simpl;apply I.
Qed.

Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y.
Proof.
intros a b.
unfold Is_true.
destruct a;destruct b;simpl;intros;try(reflexivity);contradiction.
Qed.

Lemma orb_prop_elim :
  forall a b:bool, Is_true (orb a b) -> Is_true a \/ Is_true b.
Proof.
intros a b;destruct a;destruct b;simpl;intros.
left;apply I.
left;apply I.
right;apply I.
right;contradiction.
Qed.

Lemma orb_prop_intro :
  forall a b:bool, Is_true a \/ Is_true b -> Is_true (orb a b).
Proof.
intros a b;destruct a;destruct b;simpl;intros;try(apply I).
inversion H;contradiction.
Qed.

Lemma andb_prop_intro :
  forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (andb b1 b2).
Proof.
intros a b;destruct a;destruct b;simpl;intros h;inversion h as [l r].
apply I.
contradiction.
contradiction.
contradiction.
Qed.

Lemma andb_prop_elim :
  forall a b:bool, Is_true (andb a b) -> Is_true a /\ Is_true b.
Proof.
intros a b;destruct a;destruct b;simpl;intros;split;
try(apply I);try(contradiction).
Qed.

Lemma eq_bool_prop_intro :
  forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2.
Proof.
intros a b;destruct a;destruct b;simpl;intro h;inversion h as [l r];try(reflexivity).
contradiction.
contradiction.
Qed.

Lemma eq_bool_prop_elim : forall b1 b2, b1 = b2 -> (Is_true b1 <-> Is_true b2).
Proof.
intros a b;destruct a;destruct b;simpl;split;intro h;
try(apply I);try(discriminate);try(contradiction).
Qed.

Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b.
Proof.
intros b;destruct b;simpl;intros h n;contradiction.
Qed.

Lemma negb_prop_intro : forall b, ~ Is_true b -> Is_true (negb b).
Proof.
intro b;destruct b;simpl;intro h.
contradiction. trivial.
Qed.

Lemma negb_prop_classical : forall b, ~ Is_true (negb b) -> Is_true b.
Proof.
intros b;destruct b;simpl;intro h.
trivial.
apply h;trivial.
Qed.

Lemma negb_prop_involutive : forall b, Is_true b -> ~ Is_true (negb b).
Proof.
intro b;destruct b;simpl;intros h n;contradiction.
Qed.

Lemma andb_if : forall (A:Type)(a a':A)(b b' : bool),
  (if (andb b b') then a else a') =
  (if b then if b' then a else a' else a').
Proof.
intros A a1 a2 b1 b2.
destruct b1;destruct b2;simpl;reflexivity.
Qed.

Lemma negb_if : forall (A:Type)(a a':A)(b:bool),
 (if negb b then a else a') =
 (if b then a' else a).
Proof.
intros A x y b;destruct b;simpl;reflexivity.
Qed.

Definition andbl (a b:bool) := if a then b else false.
Definition orbl (a b:bool) := (if a then true else b).

Lemma andb_lazy_alt : forall a b : bool, andb a b = andbl a b.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Lemma orb_lazy_alt : forall a b : bool, orb a b = orbl a b.
Proof.
intros a b;destruct a;destruct b;reflexivity.
Qed.

Inductive reflect (P : Prop) : bool -> Set :=
  | ReflectT : P -> reflect P true
  | ReflectF : ~ P -> reflect P false.

Lemma reflect_iff : forall P b, reflect P b -> (P<->b=true).
Proof.
intros P b h.
destruct b;split;simpl;intro p;try(reflexivity);inversion h;try(assumption);try(reflexivity);try(contradiction);try(discriminate).
Qed.

Lemma iff_reflect : forall P b, (P<->b=true) -> reflect P b.
Proof.
intros P b.
destruct b;simpl;intro h;inversion h as [l r].
apply ReflectT. apply r. reflexivity.
apply ReflectF. intro p.
discriminate (l p).
Defined.

Lemma reflect_dec : forall P b, reflect P b -> {P}+{~P}.
Proof.
intros P b h.
destruct b;inversion h.
left;assumption.
right;assumption.
Defined.


(* Use of this source code is governed by the license described	*
 * in the LICENSE file at the root of the source tree.		*)

(* A simple symmetric encryption scheme based on a pseudorandom function, and a proof that the scheme is secure according to IND-CPA. *)

Set Implicit Arguments.

Require Import FCF.
Require Import PRF.
Require Import Encryption.
Require Import RndInList.
Require Import OTP.
Require Import WC_PolyTime.

Opaque evalDist.
Opaque getSupport.

Local Open Scope nat_scope.
Local Open Scope type_scope.
Local Open Scope list_scope.

Section PRF_Encryption_concrete.

  Variable eta : nat.

  Definition Key := Bvector eta.
  Definition Plaintext := Bvector eta.
  Definition Ciphertext := Bvector eta * Bvector eta.

  Variable f : Bvector eta -> Bvector eta -> Bvector eta.

  Definition PRFE_KeyGen :=
    {0, 1} ^ eta.

  Definition PRFE_Encrypt (k : Key )(p : Plaintext) :=
    r <-$ {0, 1} ^ eta;
    pad <- f k r;
    ret (r, p xor pad).

  Definition PRFE_Decrypt (k : Key)(c : Ciphertext) :=
    r <- fst c;
    pad <- f k r;
    (snd c) xor pad.

  Theorem PRF_Encrypt_correct :
    forall k p c,
      In c (getSupport (PRFE_Encrypt k p)) ->
      PRFE_Decrypt k c = p.

    intuition.
    unfold PRFE_Encrypt, PRFE_Decrypt in *.
    repeat simp_in_support.

    simpl.
    rewrite BVxor_assoc.
    rewrite BVxor_same_id.
    rewrite BVxor_id_r.
    intuition.
  Qed.

  Section PRF_Encryption_IND_CPA_concrete.

    Variable State : Set.
    Hypothesis State_EqDec : EqDec State.
    Variable A1 : OracleComp Plaintext Ciphertext (Plaintext * Plaintext * State).
    Variable A2 : State -> Ciphertext -> OracleComp Plaintext Ciphertext bool.

    Hypothesis A1_wf : well_formed_oc A1.
    Hypothesis A2_wf : forall x y, well_formed_oc (A2 x y).

    Variable q1 q2 : nat.
    Hypothesis A1_qam : queries_at_most A1 q1.
    Hypothesis A2_qam : forall s c, queries_at_most (A2 s c) q2.

    Definition PRFE_EncryptOracle := EncryptOracle PRFE_Encrypt _.

    Local Open Scope nat_scope.

    (* Step 1: Inline some definitions and simplify. *)
    Definition G1 :=
      key <-$ PRFE_KeyGen;
      [b, _] <-$2
      (
        [p0, p1, s_A] <--$3 A1;
        b <--$$ {0, 1};
        pb <- if b then p1 else p0;
        c <--$$ PRFE_Encrypt key pb;
        b' <--$ (A2 s_A c);
        $ ret (eqb b b')
      )
      _ _
      (PRFE_EncryptOracle key) tt;
      ret b.

    Theorem G1_equiv :
      Pr[IND_CPA_SecretKey_G PRFE_KeyGen PRFE_Encrypt A1 A2 _] == Pr[G1].
      reflexivity.

    Qed.

    (* Step 2 : Replace the PRF with a random function. *)

    Definition PRFE_RandomFunc := @randomFunc (Bvector eta) (Bvector eta) ({0,1}^eta) _.

    Definition RF_Encrypt s p :=
      r <-$ {0, 1} ^ eta;
      [pad, s] <-$2 PRFE_RandomFunc s r;
      ret (r, p xor pad, s).

    Definition G2 :=
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        [c, o] <-$2 RF_Encrypt o pb;
        [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
        ret (eqb b b').

    (* To prove this step, we put the game in the form of a computation that access the PRF as an oracle.  This allows us to apply the PRF definition. *)

    Definition PRFE_Encrypt_OC (x : unit)(p : Plaintext) : OracleComp (Bvector eta) (Bvector eta) (Ciphertext * unit) :=
        r <--$$ {0, 1} ^ eta;
        pad <--$ OC_Query _ r;
        $ (ret (r, p xor pad, tt)).

    Definition PRF_A : OracleComp (Bvector eta) (Bvector eta) bool :=
      [a, n] <--$2 OC_Run _ _ _ A1 PRFE_Encrypt_OC tt;
      [p0, p1, s_A] <-3 a;
      b <--$$ {0, 1};
      pb <- if b then p1 else p0;
      r <--$$ {0, 1} ^ eta;
      pad <--$ OC_Query _ r;
      c <- (r, pb xor pad);
      z <--$ OC_Run  _ _ _ (A2 s_A c) PRFE_Encrypt_OC n;
      [b', _] <-2 z;
      $ ret (eqb b b').

    (* Later we will need to reason about the cost of PRF_A, so we make an equivalent procedure without some of the complications. *)
    Definition PRF_A' :=
      z <--$
      OC_Run _ _ _ A1 PRFE_Encrypt_OC tt;
      b <--$$
      (m <-$ { 0 , 1 }^1; ret Vector.hd m);
      r <--$$ { 0 , 1 }^eta;
      pad <--$ OC_Query (Vector.t bool eta) r;
      z0 <--$
      OC_Run _ _ _ (A2 (snd (fst z)) (r,
        (if b then  (snd (fst (fst z)))  else (fst (fst (fst z))))
        xor pad)) PRFE_Encrypt_OC (snd z);
       $ ret eqb b (fst z0).

    Theorem PRF_A'_equiv :
      forall (S : Set)(eqds : EqDec S)(o : S -> (Bvector eta) -> Comp ((Bvector eta) * S)) s x,
      evalDist (PRF_A _ _ o s) x == evalDist (PRF_A' _ _ o s) x.

      intuition.
      unfold PRF_A, PRF_A'.

      do 5 (comp_simp; simpl;
      comp_skip; try eapply eqRat_refl).
      comp_simp; simpl.
      comp_simp.
      intuition.

    Qed.

    Definition f_oracle(k : Bvector eta)(x : unit)(v : Bvector eta) :=
      ret (f k v, tt).

    Theorem Ciphertext_inh :
      Ciphertext.

      apply (oneVector eta, oneVector eta).

    Qed.
    Hint Resolve Ciphertext_inh : inhabited.

    Theorem PRFE_EncryptOracle_spec : forall a x2 x,
       comp_spec
     (fun (y1 : Ciphertext * unit) (y2 : Ciphertext * (unit * unit)) =>
      fst y1 = fst y2 /\ snd y1 = fst (snd y2))
     (PRFE_EncryptOracle x (fst x2) a)
     (p <-$
      (PRFE_Encrypt_OC (fst x2) a) unit unit_EqDec (f_oracle x) (snd x2);
      ret (fst (fst p), (snd (fst p), snd p))).

      intuition.
      unfold PRFE_EncryptOracle, EncryptOracle, PRFE_Encrypt.
      simpl.

      prog_inline_l.
      do 2 prog_inline_r.
      comp_skip.
      prog_simp.
      unfold f_oracle.
      do 2 (prog_inline_r;
      prog_simp).
      eapply comp_spec_ret.
      simpl.
      intuition.

    Qed.

    Theorem RF_EncryptOracle_spec : forall a x2,
      comp_spec
      (fun (y1 : Ciphertext * list (Bvector eta * Bvector eta))
        (y2 : Ciphertext * (unit * list (Bvector eta * Bvector eta))) =>
        fst y1 = fst y2 /\ snd y1 = snd (snd y2)) (RF_Encrypt (snd x2) a)
      (p <-$
        (PRFE_Encrypt_OC (fst x2) a) (list (Bvector eta * Bvector eta))
        (list_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta)))
        PRFE_RandomFunc (snd x2); ret (fst (fst p), (snd (fst p), snd p))).

      intuition.
      unfold RF_Encrypt, PRFE_RandomFunc, randomFunc.
      simpl.
      do 2 prog_inline_r.
      comp_skip.
      prog_simp.
      prog_inline_r.
      comp_skip.
      prog_inline_r.
      prog_simp.
      eapply comp_spec_ret.
      simpl.
      intuition.

    Qed.

    Theorem G1_PRF_A_equiv :
      Pr[G1] == Pr[k <-$ {0, 1}^ eta; [b, _] <-$2 PRF_A _ _ (f_oracle k) tt; ret b].

      Opaque PRFE_Encrypt_OC.

      unfold G1, PRF_A, PRFE_KeyGen.
      comp_skip.

      simpl.
      inline_first.

      eapply comp_spec_impl_eq.
      eapply (@comp_spec_seq _ _
        (fun a1 a2 => fst a1 = fst a2 /\ snd a1 = fst (snd a2))); eauto with inhabited.

      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun a b => a = fst b)).
      trivial.
      intuition.
      subst.

      eapply PRFE_EncryptOracle_spec.
      intuition.
      destruct b2.
      simpl in *.
      subst.

      prog_simp.
      simpl.

      do 2 prog_inline_l.
      do 2 prog_inline_r.
      comp_skip.
      prog_simp.

      unfold PRFE_Encrypt.
      do 3 prog_inline_l.
      do 2 (prog_inline_r; prog_simp).
      comp_skip.
      prog_simp.

      unfold f_oracle.
      prog_inline_l.
      do 3 (prog_inline_r; prog_simp).

      eapply comp_spec_seq; eauto with inhabited.
      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _
        (fun a b => a = fst b)).
      trivial.
      intuition.
      subst.

      eapply PRFE_EncryptOracle_spec.
      intuition.
      destruct b4; simpl in *; subst.

      prog_simp.
      simpl.
      prog_inline_l; prog_simp.
      prog_inline_r; prog_simp.
      eapply comp_spec_ret.
      intuition.

    Qed.

    Theorem G1_PRF_A'_equiv :
      Pr[k <-$ {0, 1}^ eta; [b, _] <-$2 PRF_A _ _ (f_oracle k) tt; ret b] ==
      Pr[k <-$ {0, 1}^ eta; [b, _] <-$2 PRF_A' _ _ (f_oracle k) tt; ret b].

      intuition.
      comp_skip.
      comp_skip.
      eapply PRF_A'_equiv.

    Qed.

    Theorem G2_PRF_A_equiv :
      Pr[G2] == Pr[[b, _] <-$2 PRF_A _ _ PRFE_RandomFunc nil; ret b].
      pose proof RF_EncryptOracle_spec as RFE_spec.

      unfold G2, PRF_A.
      simpl.
      inline_first.

      eapply comp_spec_impl_eq.
      eapply (@comp_spec_seq _ _
        (fun a1 a2 => fst a1 = fst a2 /\ snd a1 = snd (snd a2))); eauto with inhabited.

      eapply comp_spec_consequence.
      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun a b => a = snd b)).
      trivial.
      intuition.
      subst.

      eapply RFE_spec.
      intuition.
      intuition.
      prog_simp.
      simpl.

      do 2 prog_inline_r.
      comp_skip.
      unfold RF_Encrypt at 1.
      prog_simp.
      prog_inline_l.
      do 2 prog_inline_r.
      comp_skip.
      prog_simp.
      simpl in *.
      subst.

      prog_inline_l.
      prog_inline_r.
      comp_skip.
      inversion H3; clear H3; subst.
      do 2 prog_inline_r.
      eapply comp_spec_seq; eauto with inhabited.
      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun x y => x = snd y)).
      trivial.
      intuition.
      subst.

      eapply RFE_spec.
      intuition.
      prog_simp.
      simpl.
      prog_inline_r.
      simpl.
      prog_simp.
      eapply comp_spec_ret.
      simpl in *.
      intuition.
      subst.
      intuition.
      subst; intuition.

    Qed.

    Theorem G2_PRF_A'_equiv :
      Pr[[b, _] <-$2 PRF_A _ _ PRFE_RandomFunc nil; ret b] ==
      Pr[[b, _] <-$2 PRF_A' _ _ PRFE_RandomFunc nil; ret b].

      intuition.
      comp_skip.
      eapply PRF_A'_equiv.

    Qed.

    Theorem G1_G2_close : |Pr[G1] - Pr[G2]| == PRF_Advantage ({0, 1}^eta) ({0, 1}^eta) f _ _ PRF_A'.
      rewrite G1_PRF_A_equiv.
      rewrite G1_PRF_A'_equiv.
      rewrite G2_PRF_A_equiv.
      rewrite G2_PRF_A'_equiv.
      reflexivity.
    Qed.

    (* Step 3 : replace the PRF output with random value *)
    (* This is identical to G2 as long as the adversary does not encounter the encryption nonce during a query. *)

    Definition G3 :=
    [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
    [p0, p1, s_A] <-3 a;
    b <-$ {0, 1};
    pb <- if b then p1 else p0;
      r <-$ {0, 1}^eta;
      pad <-$ {0, 1}^eta;
      c <- (r, pb xor pad);
      [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
      ret (eqb b b').

    (* start with G2 and move the challenge encryption sampling to the front. *)
    Definition G2_1 :=
      r <-$ {0, 1}^eta;
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        [pad, o] <-$2 PRFE_RandomFunc o r;
        c <- (r, pb xor pad);
        [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
        ret (eqb b b').

    Theorem G2_1_equiv :
      Pr[G2] == Pr[G2_1].

      unfold G2, G2_1.

      do 2 (comp_swap_r; comp_skip; comp_simp).
      unfold RF_Encrypt.
      do 2(inline_first; comp_skip; comp_simp).
      intuition.
    Qed.

    (* We will modify the procedure one adversary call at a time.  Start with the first one. *)
    (* make the bad event visible. *)
    Definition G2_2 :=
      r <-$ {0, 1}^eta;
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      bad <- if (arrayLookup _ o r) then true else false;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        [pad, o] <-$2 PRFE_RandomFunc o r;
        c <- (r, pb xor pad);
        [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
        ret (eqb b b', bad).

    Theorem G2_1_2_equiv :
      Pr[G2_1] == Pr[x <-$ G2_2; ret fst x].

      unfold G2_1, G2_2.

      do 5 (inline_first; comp_skip; comp_simp).
      simpl; intuition.
    Qed.

    (* When r is not in the domain of the random function, we can sample the pad randomly, then add it to the function. *)

    Definition G2_3 :=
      r <-$ {0, 1}^eta;
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      bad <- if (arrayLookup _ o r) then true else false;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        pad <-$ {0, 1}^ eta;
        c <- (r, pb xor pad);
        [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt ((r, pad) :: o);
        ret (eqb b b', bad).

    Local Open Scope rat_scope.

    Theorem RF_Encrypt_wf :
      forall s a,
        well_formed_comp (RF_Encrypt s a).

      intuition.
      unfold RF_Encrypt.
      wftac.
      eapply randomFunc_wf.
      wftac.
    Qed.

    Hint Resolve RF_Encrypt_wf : wftac.

    Theorem G2_2_3_eq_until_bad :
      forall z,
        evalDist G2_2 (z, false) == evalDist G2_3 (z, false).
      pose proof RF_Encrypt_wf.
      intuition.
      unfold G2_2, G2_3.

      do 3 (comp_skip; comp_simp).
      unfold PRFE_RandomFunc, randomFunc.
      case_eq (arrayLookup (Bvector_EqDec eta) l x ); intuition.
      comp_simp.

      comp_irr_r; wftac.

      comp_irr_l; wftac.
      eapply oc_comp_wf; intuition.

      comp_irr_r; wftac.
      eapply oc_comp_wf; intuition.

      comp_simp.

      Local Transparent evalDist.
      Local Transparent getSupport.
      dist_compute.
      Local Opaque evalDist.
      Local Opaque getSupport.

      inline_first.
      comp_skip.

    Qed.

    Theorem G2_2_3_badness_same :
      Pr[x <-$ G2_2; ret (snd x)] == Pr[x <-$ G2_3; ret (snd x)].

      pose proof RF_Encrypt_wf.
      unfold G2_2, G2_3.

      do 3 (inline_first; comp_skip; comp_simp).

      comp_inline_l.
      comp_irr_l; wftac.
      eapply randomFunc_wf; wftac.

      comp_inline_r.
      comp_irr_r; wftac.

      comp_simp.
      comp_inline_l.
      comp_irr_l; wftac.
      eapply oc_comp_wf; intuition.

      comp_inline_r.
      comp_irr_r; wftac.
      eapply oc_comp_wf; intuition.

      comp_simp.
      simpl.
      intuition.

    Qed.

    (* provide a simplified form of the same with the same probability of badness. *)
    Definition G2_2_bad :=
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      ls <- fst (split o);
      r <-$ {0, 1}^eta;
      ret if (in_dec (EqDec_dec _) r ls) then true else false.

    Theorem arrayLookup_In_split :
      forall (A B : Set)(eqda : EqDec A)(ls : list (A * B))(a : A)(b : B),
        arrayLookup _ ls a = Some b ->
        In a (fst (split ls)).

      induction ls; intuition; simpl in *.
      discriminate.
      case_eq (eqb a a0); intuition.
      rewrite H0 in H.
      inversion H; clear H; subst.

      rewrite eqb_leibniz in H0.
      subst.
      remember (split ls) as x.
      destruct x.
      simpl.
      intuition.

      rewrite H0 in H.
      remember (split ls) as x.
      destruct x.
      simpl.
      right.
      eapply IHls.
      eauto.

    Qed.

    Theorem arrayLookup_not_In_split :
      forall (A B : Set)(eqda : EqDec A)(ls : list (A * B))(a : A),
        arrayLookup _ ls a = None ->
        ~In a (fst (split ls)).

      induction ls; intuition; simpl in *.
      case_eq (eqb a a0); intuition;
      rewrite H1 in H.
      discriminate.

      remember (split ls) as x.
      destruct x.
      simpl in *.
      intuition; subst.
      rewrite eqb_refl in H1.
      discriminate.
      eauto.
    Qed.

    Theorem G2_2_bad_equiv :
      Pr[x <-$ G2_2; ret snd x] == Pr[G2_2_bad].
      pose proof RF_Encrypt_wf.
      rewrite G2_2_3_badness_same.

      unfold G2_3, G2_2_bad.
      inline_first.
      comp_at comp_inline leftc 1%nat.
      comp_swap_l.
      comp_skip.
      comp_simp.
      comp_skip.
      do 3 (comp_inline_l;
      comp_irr_l; wftac).
      eapply oc_comp_wf; intuition.

      comp_simp.
      eapply evalDist_ret_eq; simpl.
      case_eq (arrayLookup (Bvector_EqDec eta) l x); intuition;
      destruct (in_dec (EqDec_dec (Bvector_EqDec eta)) x (fst (split l))); intuition.
      exfalso.
      eauto using arrayLookup_In_split.

      exfalso.
      eapply (@arrayLookup_not_In_split _ _ (Bvector_EqDec eta)).
      eauto.
      trivial.

    Qed.

    Theorem RF_Encrypt_length_incr :
      forall a b c d,
        In (a, b) (getSupport (RF_Encrypt c d)) ->
        (length b <= 1 + length c)%nat.

      intuition.
      unfold RF_Encrypt in *.
      repeat simp_in_support.
      destruct x0.
      repeat simp_in_support.
      unfold PRFE_RandomFunc, randomFunc in *.
      destruct (arrayLookup (Bvector_EqDec eta) c x); repeat simp_in_support;
      simpl in *; lia.

    Qed.

    Theorem G2_2_bad_small : Pr[x <-$ G2_2; ret snd x] <= q1 / (2 ^ eta).
      pose proof RF_Encrypt_wf.

      rewrite G2_2_bad_equiv.
      unfold G2_2_bad.
      comp_irr_l.
      eapply oc_comp_wf; intuition.
      comp_simp.

      assert (length l <= q1)%nat.

      eapply qam_count;
      eauto.
      eapply RF_Encrypt_length_incr.
      simpl; intuition.

      eapply RndInList_prob.
      rewrite split_length_l.
      trivial.
    Qed.

    Theorem G2_2_3_close :
      forall z,
      | evalDist (x <-$ G2_2; ret fst x) z - evalDist (x <-$ G2_3; ret fst x) z | <=
         q1 / (2 ^ eta).

      intuition.
      eapply leRat_trans.
      eapply fundamental_lemma_h.
      eapply G2_2_3_badness_same.
      eapply G2_2_3_eq_until_bad.
      eapply G2_2_bad_small.
    Qed.

    (* Now switch the the second adversary call *)

    (* for this part we need an oracle that makes the bad event visible *)
    Definition RF_Encrypt_bad (x : Bvector eta)(z : list (Bvector eta * Bvector eta) * bool) (p : Bvector eta):=
      [s, bad] <-2 z;
      r <-$ { 0 , 1 }^eta;
      z <-$ PRFE_RandomFunc s r;
      [pad, s0]<-2 z;
      ret (r, p xor pad, (s0, bad || eqb x r)).

    Definition G2_4 :=
      r <-$ {0, 1}^eta;
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        pad <-$ {0, 1}^ eta;
        c <- (r, pb xor pad);
        [b', o] <-$2 (A2 s_A c) _ _ (RF_Encrypt_bad r) ((r, pad) :: o, false);
        ret (eqb b b', (snd o)).

    Theorem G2_3_4_equiv :
      Pr[x <-$ G2_3; ret fst x] == Pr[x <-$ G2_4; ret fst x].

      unfold G2_3, G2_4.

       do 4 (inline_first; comp_skip; comp_simp).

      inline_first.
      eapply comp_spec_impl_eq.
      eapply comp_spec_seq; eauto with inhabited.
      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun a b => a = fst b)); intuition.
      destruct x3; simpl in *; subst.
      unfold RF_Encrypt.
      clear H2.
      comp_skip.
      comp_skip.
      eapply comp_spec_ret; simpl in *; intuition.

      intuition.
      simpl in *; subst.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
    Qed.

     (* When this procedure doesn't go bad, we can remove the challenge pad from the function. *)
    Definition G2_5 :=
      r <-$ {0, 1}^eta;
      [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
      [p0, p1, s_A] <-3 a;
      b <-$ {0, 1};
      pb <- if b then p1 else p0;
        pad <-$ {0, 1}^ eta;
        c <- (r, pb xor pad);
        [b', o] <-$2 (A2 s_A c) _ _ (RF_Encrypt_bad r) (o, false);
        ret (eqb b b', snd o).

    Theorem RF_Encrypt_bad_preserved :
      forall a c d e f g h,
        In (a, (c, d)) (getSupport (RF_Encrypt_bad e (f, g) h)) ->
        g = true ->
        d = true.

      intuition.
      unfold RF_Encrypt_bad in *.
      repeat simp_in_support.
      destruct x0.
      repeat simp_in_support.
      eapply orb_true_l.

    Qed.

      Theorem RF_Encrypt_bad_wf :
        forall x a b,
          well_formed_comp (RF_Encrypt_bad x a b).

        intuition.
        unfold RF_Encrypt_bad; wftac.
        eapply randomFunc_wf; wftac.

      Qed.

    Theorem G2_4_5_eq_until_bad :
      forall z,
        evalDist G2_4 (z, false) == evalDist G2_5 (z, false).

      pose proof @RF_Encrypt_bad_preserved as RF_Encrypt_bad_preserved.
      pose proof @RF_Encrypt_bad_wf as RF_Encrypt_bad_wf.
      intuition.
      unfold G2_4, G2_5.
      do 4 (comp_skip; comp_simp).

      eapply comp_spec_impl_eq.
      eapply comp_spec_seq; eauto with inhabited.
      eapply (@oc_comp_spec_eq_until_bad _ _ _ _ _ _ _ _ _ _ _ _ _
        (fun a => snd a) (fun a => snd a)
        (fun a b => forall z,  z <> x -> arrayLookup _ (fst a) z = arrayLookup _ (fst b) z)).

      intuition.
      solve [intros; apply RF_Encrypt_bad_wf].
      intuition.

      (* Prove that as long as the procedures don't go bad, the invariant holds *)
      intuition.
      simpl in H5; subst.

      (* TODO: mako this a theorem *)
      unfold RF_Encrypt_bad, PRFE_RandomFunc, randomFunc.
      comp_skip.
      case_eq (eqb x b); intuition.

      prog_irr_l.
      destruct (arrayLookup (Bvector_EqDec eta) a b); wftac.
      prog_irr_r.
      destruct (arrayLookup (Bvector_EqDec eta) a0 b); wftac.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      rewrite orb_true_r in H10.
      discriminate.
      rewrite orb_true_r in H10.
      discriminate.

      case_eq (arrayLookup (Bvector_EqDec eta) a b); intuition.
      rewrite <- H4.
      simpl.
      rewrite H8.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      intuition; subst.
      rewrite eqb_refl in H7.
      discriminate.

      rewrite <- H4.
      simpl.
      rewrite H8.
      prog_inline_l.
      prog_inline_r.
      comp_skip.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      case_eq (eqbBvector z0 b); intuition.
      intuition. subst.
      rewrite eqb_refl in H7.
      discriminate.
      intuition.

      (* Prove that once the oracle goes bad, it stays bad. *)
      eapply RF_Encrypt_bad_preserved.
      eapply H5.
      trivial.

      intuition.
      eapply RF_Encrypt_bad_preserved.
      eapply H5.
      trivial.

      (* prove that the invariant holds on the initial state *)
      intuition.
      simpl.
      case_eq (eqbBvector z0 x); intuition.
      apply eqbBvector_sound in H5; intuition.

      (* prove that the bad events are the same *)
      trivial.

      intuition.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intros.
      destruct p1; simpl in *; subst.
      intuition.
      inversion H6; clear H6; subst.
      intuition.
      subst.
      trivial.
      inversion H6; clear H6; subst.
      intuition.
      subst.
      trivial.

      Unshelve.
      eauto.
    Qed.

    Theorem G2_4_5_badness_same :
      Pr[x <-$ G2_4; ret (snd x)] == Pr[x <-$ G2_5; ret (snd x)].

      pose proof @RF_Encrypt_bad_wf as RF_Encrypt_bad_wf.
      pose proof @RF_Encrypt_bad_preserved as RF_Encrypt_bad_preserved.
      unfold G2_4, G2_5.
      do 4 (inline_first; comp_skip; comp_simp).
      inline_first.

      inline_first.

      eapply comp_spec_impl_eq.
      eapply comp_spec_seq; eauto with inhabited.

      eapply (@oc_comp_spec_eq_until_bad _ _ _ _ _ _ _ _ _ _ _ _ _
        (fun a => snd a) (fun a => snd a)
        (fun a b => forall z,  z <> x -> arrayLookup _ (fst a) z = arrayLookup _ (fst b) z)).
      intuition.
      intuition.

      intuition.
      simpl in *; subst.
      clear H2.
      comp_skip.
      (* The theorem from before would be helpful here *)
      unfold PRFE_RandomFunc, randomFunc.
      case_eq (eqbBvector x b); intuition.

      prog_irr_l.
      destruct (arrayLookup (Bvector_EqDec eta) a b); wftac.
      prog_irr_r.
      destruct ( arrayLookup (Bvector_EqDec eta) a0 b); wftac.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      rewrite orb_true_r in H9.
      discriminate.
      rewrite orb_true_r in H9.
      discriminate.

      case_eq (arrayLookup (Bvector_EqDec eta) a b); intuition.
      rewrite <- H4.
      rewrite H7.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      intuition; subst.
      rewrite eqbBvector_complete in H6.
      discriminate.
      rewrite <- H4.
      rewrite H7.
      prog_inline_l.
      prog_inline_r.
      comp_skip.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.
      case_eq (eqbBvector z b); intuition.
      intuition; subst.
      rewrite eqbBvector_complete in H6.
      discriminate.

      intros.
      destruct c.
      destruct b.
      eauto.
      trivial.

      intros.
      destruct c.
      destruct b.
      eapply RF_Encrypt_bad_preserved .
      eauto.
      trivial.

      intuition.
      simpl.
      case_eq ( eqbBvector z x); intuition.
      apply eqbBvector_sound in H5; intuition.

      trivial.

      intuition.
      prog_simp.
      clear H2.
      eapply comp_spec_ret; simpl in *; intuition.
      subst.
      trivial.
      destruct p1; simpl in *.
      subst; intuition.

      Unshelve.
      eauto.
    Qed.

      Theorem RF_Encrypt_bad_prob :
        forall x (a : list (Bvector eta * Bvector eta)) (b : Plaintext),
          (Pr  [d <-$ RF_Encrypt_bad x (a, false) b; ret snd (snd d) ] <= 1 / (2 ^ eta))%rat.

        intuition.
        unfold RF_Encrypt_bad.

        assert ( Pr
   [d <-$
    (r <-$ { 0 , 1 }^eta;
     z <-$ PRFE_RandomFunc a r;
     [pad, s0]<-2 z; ret (r, b xor pad, (s0, false || eqb x r)));
    ret snd (snd d) ] ==
    Pr
   [r <-$ { 0 , 1 }^eta;
     ret eqb x r] ).

        inline_first.
        comp_skip.
        inline_first.
        comp_irr_l.
        eapply randomFunc_wf; wftac.
        comp_simp.
        simpl; intuition.

        rewrite H. clear H.
        (* dist_compute isn't working for some reason *)
        Local Transparent evalDist.
        simpl.
        Local Opaque evalDist.

        rewrite (@sumList_exactly_one _ x).
        rewrite eqbBvector_complete.
        destruct (EqDec_dec bool_EqDec true true ); intuition.
        rewrite ratMult_1_r.
        eapply leRat_refl.
        eapply getAllBvectors_NoDup.
        eapply in_getAllBvectors.
        intuition.
        destruct ( EqDec_dec bool_EqDec (eqbBvector x b0) true); intuition.
        apply eqbBvector_sound in e; subst; intuition.
        eapply ratMult_0_r.
      Qed.

    Theorem G2_4_bad_small : Pr[x <-$ G2_4; ret snd x] <= q2 / (2 ^ eta).

      pose proof @RF_Encrypt_wf as RF_Encrypt_wf.
      pose proof @RF_Encrypt_bad_prob as RF_Encrypt_bad_prob.
      pose proof @RF_Encrypt_bad_preserved as RF_Encrypt_bad_preserved.
      unfold G2_4.
      inline_first;
      comp_irr_l; wftac.
      inline_first;
      comp_irr_l; wftac.
      eapply oc_comp_wf; intuition.
      comp_simp.
      dist_inline_l.
      comp_irr_l; wftac.
      comp_inline_l; comp_irr_l; wftac.
      comp_inline_l.

      assert ( Pr
   [a <-$
    (A2 s (x, (if x0 then p0 else p) xor x1))
      (list (Bvector eta * Bvector eta) * bool)%type
      (pair_EqDec
         (list_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta)))
         bool_EqDec) (RF_Encrypt_bad x) ((x, x1) :: l, false);
    x2 <-$ ([b', o]<-2 a; ret (eqb x0 b', snd o)); ret snd x2 ]  ==
    Pr
   [a <-$
    (A2 s (x, (if x0 then p0 else p) xor x1))
      (list (Bvector eta * Bvector eta) * bool)%type
      (pair_EqDec
         (list_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta)))
         bool_EqDec) (RF_Encrypt_bad x) ((x, x1) :: l, false);
   ret (snd (snd a))] ).

      comp_skip.
      comp_simp.
      simpl.
      intuition.
      match goal with [H4:_ |- _ ] => rewrite H4; clear H4 end.

      eapply leRat_trans.

      eapply RndInAdaptive_prob; eauto.

      intros.
      destruct a.
      simpl in *; subst.
      eapply RF_Encrypt_bad_prob.

      intuition.
      eapply RF_Encrypt_bad_preserved.
      eauto.
      trivial.

      eapply eqRat_impl_leRat.
      rewrite <- ratMult_num_den.
      eapply eqRat_terms.
      lia.
      unfold posnatMult, natToPosnat, posnatToNat.
      lia.
    Qed.

    Theorem G2_4_5_close :
      forall z,
      | evalDist (x <-$ G2_4; ret fst x) z - evalDist (x <-$ G2_5; ret fst x) z | <=
        q2 / (2 ^ eta).

      intuition.
      eapply leRat_trans.
      eapply fundamental_lemma_h.
      eapply G2_4_5_badness_same.
      eapply G2_4_5_eq_until_bad.
      eapply G2_4_bad_small.
    Qed.

    Theorem G2_5_G3_equiv :
      Pr[x <-$ G2_5; ret fst x] == Pr[G3].

      unfold G2_5, G3.
      intuition.
      inline_first.
      comp_at comp_inline leftc 1%nat.
      comp_swap_l.
      comp_skip.
      comp_simp.
      comp_swap_r.
      comp_skip.
      comp_inline_l.
      comp_skip.
      inline_first; comp_skip.
      inline_first.
      eapply comp_spec_impl_eq.
      eapply comp_spec_seq; eauto with inhabited.
      eapply (@oc_comp_spec_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun a b => fst a = b)); intuition.
      simpl in *; subst.
      unfold RF_Encrypt.
      comp_skip.
      comp_skip.
      eapply comp_spec_ret; simpl in *; intuition.

      intuition.
      simpl in *; subst.
      prog_simp.
      eapply comp_spec_ret; simpl in *; intuition.

    Qed.

   Theorem G2_G3_close :
    | Pr[G2] - Pr[G3] | <= q1 / (2 ^ eta) + q2 / (2 ^ eta).

     rewrite G2_1_equiv.
     rewrite G2_1_2_equiv.
     eapply ratDistance_le_trans.
     eapply G2_2_3_close.
     rewrite G2_3_4_equiv.
     rewrite <- G2_5_G3_equiv.
     eapply G2_4_5_close.
   Qed.

   (* Step 4 : apply one-time pad argument to replace ciphertext with random values *)
   Definition G4 :=
    [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
    [p0, p1, s_A] <-3 a;
    b <-$ {0, 1};
    pb <- if b then p1 else p0;
      r <-$ {0, 1}^eta;
      pad <-$ {0, 1}^eta;
      c <- (r, pad);
      [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
      ret (eqb b b').

    (* Put the game into the form expected by the argument. *)
    Definition G3_1 :=
    [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
    [p0, p1, s_A] <-3 a;
    b <-$ {0, 1};
    pb <- if b then p1 else p0;
      r <-$ {0, 1}^eta;
      pad <-$ (x <-$ {0, 1}^eta; ret (pb xor x));
      c <- (r, pad);
      [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
      ret (eqb b b').

    Theorem G3_G3_1_equiv:
      Pr[G3] == Pr[G3_1].

      unfold G3, G3_1.

      repeat (comp_simp;
        inline_first;
        comp_skip).
    Qed.

    Theorem G3_1_G4_equiv:
      Pr[G3_1] == Pr[G4].

      unfold G3_1, G4.
      do 4 (comp_skip;
      comp_simp).
      apply xor_OTP_eq.
      reflexivity.
    Qed.

    Theorem G3_G4_equiv :
      Pr[G3] == Pr[G4].

      rewrite G3_G3_1_equiv.
      eapply G3_1_G4_equiv.

    Qed.

    (* Step 5: Move the coin toss to the end to produce a game that that the adversary obviously wins with probability 1/2. *)
    Definition G5 :=
    [a, o] <-$2 A1 _ _ (RF_Encrypt) nil;
    [p0, p1, s_A] <-3 a;
    r <-$ {0, 1}^eta;
    pad <-$ {0, 1}^eta;
    c <- (r, pad);
    [b', o] <-$2 (A2 s_A c) _ _ RF_Encrypt o;
    b <-$ {0, 1};
    ret (eqb b b').

    Theorem G4_G5_equiv :
      Pr[G4] == Pr[G5].

      unfold G4, G5.
      do 3 (comp_skip; comp_simp; comp_swap_l).
      comp_skip; comp_simp.
      reflexivity.
    Qed.

    (* Show that the probability of the adversary winning G5 is 1/2 *)
    Theorem G5_one_half :
      Pr[G5] == 1/2.

      pose proof @RF_Encrypt_wf as RF_Encrypt_wf.
      unfold G5.

      comp_irr_l.
      eapply oc_comp_wf; intuition.

      comp_simp.

      do 3 (comp_irr_l; wftac).
      eapply oc_comp_wf; intuition.

      comp_simp.

      Transparent evalDist.
      Transparent getSupport.

      dist_compute.

      Opaque evalDist.
      Opaque getSupport.

    Qed.

    Theorem PRFE_IND_CPA_concrete :
      IND_CPA_SecretKey_Advantage PRFE_KeyGen PRFE_Encrypt A1 A2 _ <=
      PRF_Advantage ({0, 1}^eta) ({0, 1}^eta) f _ _ PRF_A' +
      (q1 / 2^eta + q2 / 2^eta).

      unfold IND_CPA_SecretKey_Advantage.
      rewrite G1_equiv.
      eapply ratDistance_le_trans.
      eapply eqRat_impl_leRat.
      eapply G1_G2_close.

      eapply leRat_trans.
      eapply ratDistance_le_trans.
      eapply G2_G3_close.
      eapply eqRat_impl_leRat.
      rewrite <- ratIdentityIndiscernables.
      rewrite G3_G4_equiv.
      rewrite G4_G5_equiv.
      eapply G5_one_half.
      eapply eqRat_impl_leRat.
      symmetry.
      eapply ratAdd_0_r.
    Qed.

    (* Concrete cost of executing the constructed adversary *)
    Context `{function_cost_model}.
    Local Open Scope nat_scope.

    Variable A1_cost : nat -> nat.
    Hypothesis A1_cost_correct : oc_cost cost (comp_cost cost) A1 A1_cost.
    Variable A2_cost_1 : nat.
    Hypothesis A2_cost_1_correct : cost (fun p => A2 (fst p) (snd p)) A2_cost_1.
    Variable A2_cost_2 : nat -> nat.
    Hypothesis A2_cost_correct : forall x y, oc_cost cost (comp_cost cost) (A2 x y) A2_cost_2.

    Theorem PRFE_Encrypt_OC_cost_1 :
        cost PRFE_Encrypt_OC 0.

        Transparent PRFE_Encrypt_OC.
        unfold PRFE_Encrypt_OC.
        eapply cost_const.
      Qed.

      Theorem PRFE_Encrypt_OC_cost_2 :
        forall x, cost (PRFE_Encrypt_OC x) (2 * eta).

        intuition.
        Transparent PRFE_Encrypt_OC.
        unfold PRFE_Encrypt_OC.
        eapply cost_le.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_1.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_1.
        eapply cost_compose_unary; costtac.
        eapply cost_compose_unary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_1.
        eapply cost_BVxor.
        intuition.
        eapply cost_uncurry_2.
        eapply cost_BVxor.

        lia.

      Qed.

      Theorem PRFE_Encrypt_OC_oc_cost :
         forall (x : unit) (y : Bvector eta),
           oc_cost cost (comp_cost cost) (PRFE_Encrypt_OC x y) (fun x => x + 3*eta).

        intuition.
        eapply oc_cost_le.
        unfold PRFE_Encrypt_OC.
        costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_1.
        eapply cost_compose_unary; costtac.
        eapply cost_compose_unary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_2.
        eapply cost_BVxor.
        intuition.
        costtac.

        eapply cost_compose_unary; costtac.
        eapply cost_compose_unary; costtac.
        eapply cost_compose_binary; costtac.
        eapply cost_uncurry_2.
        eapply cost_BVxor.
        eapply cost_pair_2.
        intuition.
        costtac.

        intuition.
      Qed.

    Theorem PRF_A'_cost :
      oc_cost cost (comp_cost cost) PRF_A'
       (fun x => (A1_cost (x + (5 * eta))) + (A2_cost_2 (x + (5 * eta))) +
        x + 5 * A2_cost_1 + 6 + 7 * eta).

      pose proof @PRFE_Encrypt_OC_cost_2 as PRFE_Encrypt_OC_cost_2.
      pose proof @PRFE_Encrypt_OC_oc_cost as PRFE_Encrypt_OC_oc_cost.
      unfold PRF_A'.

      eapply oc_cost_le.

      costtac.
      eauto.

      eapply PRFE_Encrypt_OC_cost_1.
      eapply PRFE_Encrypt_OC_cost_2.
      eapply PRFE_Encrypt_OC_oc_cost.

      costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.

      eapply (@cost_compose _ _ _ _ _
        (fun a => (snd (fst (fst (fst a)))))
        (fun (a : Plaintext * Plaintext * State * unit * bool * Bvector eta *
            Vector.t bool eta) => (OC_Run
        unit_EqDec
        (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta)
        (A2 (snd (fst (fst (fst (fst a)))))
           (snd (fst a),
           (if snd (fst (fst a))
            then snd (fst (fst (fst (fst (fst a)))))
            else fst (fst (fst (fst (fst (fst a)))))) xor
           snd a))
        PRFE_Encrypt_OC ))
        ); costtac.

      eapply (@cost_compose_unary _ _ _ _ _
        (fun a : (Plaintext * Plaintext * State * unit * bool * Bvector eta *
            Vector.t bool eta) => (A2 (snd (fst (fst (fst (fst a)))))
           (snd (fst a),
           (if snd (fst (fst a))
            then snd (fst (fst (fst (fst (fst a)))))
            else fst (fst (fst (fst (fst (fst a)))))) xor
           snd a)))

        (fun x =>
           OC_Run unit_EqDec
        (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta) x PRFE_Encrypt_OC)
        ).

      eapply cost_compose_binary; costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_if_bool; costtac.
      eapply cost_uncurry_1.
      eapply cost_BVxor.
      eapply cost_uncurry_2.
      eapply cost_BVxor.

      eapply cost_uncurry_1.
      eauto.
      eapply cost_uncurry_2.
      eauto.

      eapply (@cost_compose _ _ _ _ _
        (fun x => _)
        ( OC_Run unit_EqDec
        (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta))
        ); costtac.

      eapply cost_OC_Run_1.
      intuition.
      eapply cost_OC_Run_2.
      intuition.
      eapply cost_OC_Run_3.

      eapply cost_uncurry_1.
      eapply cost_compose_unary; costtac.
      eapply cost_compose_binary; costtac.

      eapply cost_uncurry_1.
      eapply cost_eqb_bool.
      eapply cost_uncurry_2.
      eapply cost_eqb_bool.

      intuition.
      costtac.
      eapply cost_vec_head.
      intuition.
      costtac.

      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.
      simpl.

      eapply (@cost_compose _ _ _ _ _
        (fun a => _)
        (fun a0 : bool * Bvector eta * Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta)
        (A2 b0 (snd (fst a0), (if fst (fst a0) then b1 else a) xor snd a0))
        PRFE_Encrypt_OC)

        ); costtac.

      eapply (@cost_compose _ _ _ _ _
        (fun a => _)
        (fun a0 : bool * Bvector eta * Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta)
        (A2 b0 (snd (fst a0), (if fst (fst a0) then b1 else a) xor snd a0)))

        ); costtac.

      eapply cost_compose_binary; costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_if_bool; costtac.
      eapply cost_uncurry_1.
      eapply cost_BVxor.
      intuition.
      eapply cost_uncurry_2.
      eapply cost_BVxor.
      eapply cost_uncurry_2.
      eauto.
      eapply cost_OC_Run_1.
      intuition.
      eapply cost_OC_Run_2.
      intuition.
      eapply cost_OC_Run_3.
      eapply cost_uncurry_1.
      eapply cost_compose_unary; costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_eqb_bool.
      intuition.
      eapply cost_uncurry_2.
      eapply cost_eqb_bool.

      intuition.
      costtac.
      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_1.
      eapply cost_compose_binary; costtac.
      simpl.

      eapply (@cost_compose _ _ _ _ _
        (fun a => _)
        (fun a0 : Bvector eta * Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta)
        (A2 b0 (fst a0, (if y then b1 else a) xor snd a0)) PRFE_Encrypt_OC)
        ); costtac.

      eapply (@cost_compose _ _ _ _ _
        (fun a => _)
        (fun a0 : Bvector eta * Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta)
        (A2 b0 (fst a0, (if y then b1 else a) xor snd a0)))
        ); costtac.

      eapply cost_compose_binary; costtac.
      eapply cost_uncurry_2.
      eapply cost_BVxor.
      eapply cost_uncurry_2.
      eauto.
      eapply cost_OC_Run_1.
      intuition.
      eapply cost_OC_Run_2.
      intuition.
      eapply cost_OC_Run_3.

      intuition.
      costtac.
      eapply cost_compose_binary; costtac.
      simpl.
      eapply (@cost_compose _ _ _  _ _
        (fun a => _)
         (fun a0 : Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta) (A2 b0 (y0, (if y then b1 else a) xor a0))
        PRFE_Encrypt_OC)
        ); costtac.

      eapply (@cost_compose _ _ _  _ _
        (fun a => _)
         (fun a0 : Vector.t bool eta =>
      OC_Run unit_EqDec (pair_EqDec (Bvector_EqDec eta) (Bvector_EqDec eta))
        (Bvector_EqDec eta) (A2 b0 (y0, (if y then b1 else a) xor a0))
        )
        ); costtac.

      eapply cost_uncurry_2.
      eapply cost_BVxor.
      eapply cost_pair_2.
      eapply cost_uncurry_2.
      eauto.
      eapply cost_OC_Run_1.
      intuition.
      eapply cost_OC_Run_2.
      intuition.
      eapply cost_OC_Run_3.
      intuition.
      costtac.
      simpl.
      eauto.

      eapply PRFE_Encrypt_OC_cost_1.
      eapply PRFE_Encrypt_OC_cost_2.
      eapply PRFE_Encrypt_OC_oc_cost.

      eapply cost_uncurry_2.
      eapply cost_eqb_bool.

      intuition.
      costtac.

      intuition.

      simpl.
      repeat rewrite plus_0_r.

      (* lia can't handle the functions -- remove them *)
      assert (A1_cost (eta + eta + (x + (eta + (eta + eta)))) =
        A1_cost (x + (eta + (eta + (eta + (eta + eta)))))).
      f_equal; lia.
      rewrite H0.
      clear H0.
      remember ( A1_cost (x + (eta + (eta + (eta + (eta + eta)))))) as t1.
      assert (A2_cost_2 (eta + eta + (x + (eta + (eta + eta)))) =
        A2_cost_2 (x + (eta + (eta + (eta + (eta + eta)))))).
      f_equal; lia.
      rewrite H0.
      clear H0.
      remember (A2_cost_2 (x + (eta + (eta + (eta + (eta + eta)))))) as t2.
      lia.
    Qed.

  End PRF_Encryption_IND_CPA_concrete.

End PRF_Encryption_concrete.

Require Import Asymptotic.

Section PRF_Encryption.

  Context `{function_cost_model}.

  Local Open Scope nat_scope.

  Variable f : forall n, Bvector n -> Bvector n -> Bvector n.

  Section PRF_Encryption_IND_CPA.

    Variable State : nat -> Set.
    Variable A1 : forall n, OracleComp (Plaintext n) (Ciphertext n) (Plaintext n * Plaintext n * State n).
    Variable A2 : forall n, State n -> Ciphertext n -> OracleComp (Plaintext n) (Ciphertext n) bool.

    Hypothesis A1_admissible :
      admissible_oc cost _ _ _ A1.

    Hypothesis A2_admissible :
      admissible_oc_func_2 cost _ _ _ _ _ A2.

    Theorem PRFE_Encrypt_OC_poly_time :
      poly_time_nonuniform_oc_func_2 cost _ _ _ _ _ PRFE_Encrypt_OC.

      unfold poly_time_nonuniform_oc_func_2.
      exists (fun x o => o + 3*x).
      exists (fun x => 2 * x).
      intuition.

      eapply polynomial_plus; intuition.
      eapply polynomial_mult.
      eapply polynomial_const.
      eapply polynomial_ident.

      eapply polynomial_mult.
      eapply polynomial_const.
      eapply polynomial_ident.

      eapply cost_le.
      eapply cost_curry.
      eapply (PRFE_Encrypt_OC_cost_1 n).
      eapply (@PRFE_Encrypt_OC_cost_2 n); eauto.
      lia.

      eapply PRFE_Encrypt_OC_oc_cost; intuition.

    Qed.

    Theorem PRFE_Encrypt_wf :
       forall n x (y : Bvector n), well_formed_oc (PRFE_Encrypt_OC x y).

      intuition.
      econstructor.
      econstructor.
      wftac.
      intuition.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      wftac.

    Qed.

    Theorem PRF_A'_wf :
      forall n, well_formed_oc (PRF_A' (A1 n) (@A2 n)).

      intuition.
      econstructor.
      econstructor.
      eapply A1_admissible.
      eapply PRFE_Encrypt_wf.
      intuition.
      econstructor.
      econstructor.
      wftac.
      intuition.
      econstructor.
      econstructor.
      wftac.
      intuition.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      econstructor.
      simpl.
      eapply A2_admissible.
      intuition.
      eapply PRFE_Encrypt_wf.
      intuition.
      econstructor.
      wftac.

    Qed.

    Theorem PRF_A'_poly_time :
      poly_time_nonuniform_oc cost _ _ _ (fun n => PRF_A' (A1 n) (@A2 n)).

      intuition.
      unfold PRF_A'.
      unfold poly_time_nonuniform_oc.

      destruct (PRFE_Encrypt_OC_poly_time).
      destruct H0.
      unfold admissible_oc in *.
      unfold admissible_oc_func_2 in *.
      intuition.
      destruct H0.
      destruct H2.
      destruct H2.
      intuition.

      exists (fun x o : nat =>
     x1 x (o + 5 * x) + x2 x (o + 5 * x) + o + 5 * (x3 x) + 6 +
     7 * x).

      intuition.
      eapply polynomial_plus.
      eapply polynomial_plus.
      eapply polynomial_plus.
      eapply polynomial_plus.
      eapply polynomial_plus.
      eapply H6.
      eapply polynomial_plus; intuition.
      eapply polynomial_mult.
      eapply polynomial_const.
      eapply polynomial_ident.
      eapply H0.
      eapply polynomial_plus; intuition.
      eapply polynomial_mult.
      eapply polynomial_const.
      eapply polynomial_ident.
      intuition.
      eapply polynomial_mult.
      eapply polynomial_const.
      intuition.
      eapply polynomial_const.
      eapply polynomial_mult.
      eapply polynomial_const.
      eapply polynomial_ident.

      eapply oc_cost_le.
      eapply PRF_A'_cost;
      eauto.
      eapply H12.
      intuition.
      eapply H12.
      intuition.

    Qed.

    Theorem PRFE_Encrypt_OC_qam :
      forall n x (y : Bvector n), queries_at_most (PRFE_Encrypt_OC x y) 1.

      intuition.
      unfold PRFE_Encrypt_OC.
      econstructor.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      econstructor.
      intuition.
      econstructor.

      lia.

    Qed.

    Theorem PRF_A'_poly_queries :
      polynomial_queries_oc _ _ _
      (fun n  => PRF_A' (A1 n) (@A2 n)).

      unfold admissible_oc, admissible_oc_func_2 in *.
      intuition.
      destruct H5.
      destruct H6.
      intuition.
      exists (fun n => x n + (1 + x0 n)).
      intuition.
      eapply polynomial_plus; intuition.
      eapply polynomial_plus; intuition.
      eapply polynomial_const.

      eapply qam_le.
      econstructor.
      econstructor.
      eauto.
      intuition.

      eapply PRFE_Encrypt_OC_qam.

      intuition.
      econstructor.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      econstructor.
      intuition.
      econstructor.
      econstructor.
      econstructor.
      eapply H8.
      eapply le_refl.
      eapply le_refl.
      intuition.
      eapply PRFE_Encrypt_OC_qam.
      intuition.
      econstructor.

      lia.

    Qed.

    Theorem PRF_A'_admissible :
      admissible_oc cost _ _ _ (fun n => PRF_A' (A1 n) (@A2 n)).

      unfold admissible_oc.
      intuition.
      eapply PRF_A'_wf.
      eapply PRF_A'_poly_time.
      eapply PRF_A'_poly_queries.

    Qed.

  End PRF_Encryption_IND_CPA.

  Theorem PRFE_IND_CPA :
    PRF _ _ _ Rnd Rnd f _ _ (admissible_oc cost) ->
    IND_CPA_SecretKey (fun n => pair_EqDec (Bvector_EqDec n) (Bvector_EqDec n))
    PRFE_KeyGen (fun n => PRFE_Encrypt (@f n))
    (admissible_oc cost)
    (admissible_oc_func_2 cost).

    unfold IND_CPA_SecretKey.
    intuition.

    destruct H1.
    destruct H2.
    intuition.
    unfold polynomial_queries_oc, polynomial_queries_oc_func_2 in *.
    destruct H7.
    destruct H8.
    intuition.

    eapply negligible_le.
    intuition.
    eapply PRFE_IND_CPA_concrete.
    eauto.
    eauto.
    eauto.
    eauto.
    eauto.

    eapply negligible_plus.
    eapply H0.
    apply PRF_A'_admissible; eauto.

    unfold admissible_oc; intuition.
    econstructor; eauto.
    unfold admissible_oc_func_2; intuition.
    econstructor; eauto.

    eapply negligible_plus.
    eapply negligible_poly_num; intuition.
    eapply negligible_poly_num; intuition.
  Qed.

  (*Print Assumptions PRFE_IND_CPA.*)

End PRF_Encryption.


Require Import Coq.ZArith.ZArith.
Require Import Crypto.Util.ZUtil.Notations.
Local Open Scope Z_scope.

Module Z.
  Lemma land_same_r : forall a b, (a &' b) &' b = a &' b.
  Proof.
    intros a b; apply Z.bits_inj'; intros n H.
    rewrite !Z.land_spec.
    case_eq (Z.testbit b n); intros;
      rewrite ?Bool.andb_true_r, ?Bool.andb_false_r; reflexivity.
  Qed.
End Z.