Require Import Logic.Syntax.
Require Import Logic.Semantics.
Require Import Logic.ProofRules.
Require Import String.
Local Open Scope HP_scope.
Local Open Scope string_scope.
Require Import List.
Require Import Strings.String.
Import ListNotations.
Require Import Rdefinitions.
Require Import RelDec.
Require Import Coq.Reals.Rbase.

(* We need to add an (axiomatized) decider for the reals, since the one in
   the standard library returns a value that cannot be matched on *)
Axiom my_req_dec : forall (a b : R),
                     {a = b} + {a <> b}.

Require Import micromega.Psatz.
Require Import ExtLib.Tactics.
Require Import FunctionalExtensionality.
Require Import ExtLib.Data.Option.

(* state utility functions *)
(* finite map lookup *)
Fixpoint fm_lookup {T : Type} (l : list (string * T)) (s : string): option T :=
  match l with
  | nil => None
  | (var, val) :: l' =>
    if string_dec s var
    then Some val
    else fm_lookup l' s
  end.

(* finite map update *)
Fixpoint fm_update {T : Type} (l : list (string * T)) (s : string) (t : T) : list (string * T) :=
  match l with
  | nil => [(s,t)]
  | (var, val) :: l' =>
    if string_dec s var
    then (var, t) :: l'
    else (var, val) :: fm_update l' s t
  end.

Module Type EMBEDDING.
  Parameter ast : Type.
  Parameter pl_data : Type.

  Parameter pl_equ : pl_data -> pl_data -> Prop.

  Axiom pl_equ_refl : forall (p : pl_data), pl_equ p p.
  Axiom pl_equ_trans : forall (p p' p'' : pl_data),
      pl_equ p p' -> pl_equ p' p'' -> pl_equ p p''.
  Axiom pl_equ_symm : forall (p p' : pl_data),
      pl_equ p p' -> pl_equ p' p.

  Definition istate : Type := list (string * pl_data).

  Parameter eval : (istate -> ast -> istate -> Prop).

  (* Embedding deterministic functions that fail by
   "getting stuck" *)

  Definition states_iso (st st' : istate) : Prop :=
    forall (s : string),
      match (fm_lookup st s), (fm_lookup st' s) with
      | None, None => True
      | Some f1, Some f2 => pl_equ f1 f2
      | _, _ => False
      end.

  Notation "a ~~ b" := (states_iso a b) (at level 70).

  (* we may want to require these but they don't seem to be necessary for our purposes *)
  Axiom eval_det :
    forall prg isti isti' istf,
      (isti ~~ isti') ->
      eval isti prg istf ->
      exists istf', istf ~~ istf' /\ eval isti' prg istf'.

  (* relate concrete to abstract variables *)
  Parameter asReal : pl_data -> R -> Prop.

  Axiom asReal_det :
    forall (p p' : pl_data) (r : R),
      asReal p r ->
      asReal p' r ->
      pl_equ p p'. (* was p = p' *)

  Axiom pl_eq_asReal :
    forall (p1 p2 : pl_data) (r : R),
      pl_equ p1 p2 -> asReal p1 r -> asReal p2 r.

  (* relate concrete to abstract states *)
  (* should all variables not in the list must be None *)
  Definition models (vars : list string) (ist : istate) (sst : Syntax.state) : Prop :=
    forall (s : string),
      (In s vars ->
      exists (d : pl_data),
        fm_lookup ist s = Some d /\
        asReal d (sst s)) /\
      (~In s vars -> fm_lookup ist s = None).

  (* type of embeddings *)
  Definition embedding : Type := list string -> ast -> Syntax.Formula.

  (* "preservation" - loosely *)
  (* this one doesn't consider terminating programs. *)
  Definition embedding_correct1 (embed : embedding) : Prop :=
    forall (v : list string) (prg : ast) (is is' : istate) (ls ls' : Syntax.state) (tr : Stream.stream Syntax.state),
      models v is ls ->
      models v is' ls' ->
      eval is prg is' ->
      Semantics.eval_formula
        (embed v prg)
        (Stream.Cons ls (Stream.Cons ls' tr)).

  (* correctness in the case of crashing programs *)
  Definition embedding_correct2 (embed : embedding) : Prop :=
    forall (v : list string) (prg : ast) (is : istate) (ls : Syntax.state) (tr : Stream.stream Syntax.state),
      models v is ls ->
      ~(exists is', eval is prg is') ->
      ~(Semantics.eval_formula
        (Enabled (embed v prg))
        (Stream.Cons ls tr)).

  (* Here is a correct embedding function.
     As we'll see below though, we depend on certain determinism properties *)
  Definition embed_ex (v : list string) (prg : ast) : Syntax.Formula :=
    Syntax.Embed (fun lpre lpost =>
                    exists cpre cpost,
                      models v cpre lpre /\
                      models v cpost lpost /\
                      eval cpre prg cpost).

  (** Next, some definitions for Hoare-style reasoning about programs.
      We use this to implement weakest-precondition.
   **)
  Section Hoare.
    Variables (P : istate -> Prop) (c : ast) (Q : istate -> Prop).

    Definition HoareProgress : Prop :=
      forall s, P s -> exists s', eval s c s'.

    Definition HoarePreservation : Prop :=
      forall s, P s ->
                forall s', eval s c s' ->
                      Q s'.

    Definition Hoare' : Prop :=
      (HoareProgress /\ HoarePreservation)%type.

    Definition Hoare : Prop :=
      (forall s, P s ->
            (exists s', eval s c s') /\
            (forall s', eval s c s' -> Q s'))%type.

  End Hoare.
End EMBEDDING.

Module Type EMBEDDING_THEOREMS.
  Declare Module M : EMBEDDING.

  Axiom states_iso_symm :
    forall (st st' : M.istate),
      M.states_iso st st' -> M.states_iso st' st.

  Axiom models_det :
    forall (v : list string) (sst : Syntax.state) (ist ist' : M.istate),
      M.models v ist sst -> M.models v ist' sst ->
      M.states_iso ist ist'.

  Axiom embed_ex_correct1 :
    M.embedding_correct1 M.embed_ex.

  Axiom embed_ex_correct2 :
    M.embedding_correct2 M.embed_ex.

  Axiom Hoare_Hoare' : forall (P : M.istate -> Prop) (c : M.ast) (Q : M.istate -> Prop), M.Hoare P c Q <-> M.Hoare' P c Q.
End EMBEDDING_THEOREMS.

Module EmbeddingProofs (M : EMBEDDING) <: EMBEDDING_THEOREMS with Module M := M.
  Module M := M.
  Import M.

  Lemma states_iso_symm :
    forall (st st' : istate),
      st ~~ st' -> st' ~~ st.
  Proof.
    induction st.
    - unfold states_iso. simpl. intros.
      specialize (H s).
      consider (fm_lookup st' s); try congruence.
    - unfold states_iso. simpl. intros.
      destruct a.
      consider (string_dec s s0); intros.
      + subst. specialize (H s0).
        consider (string_dec s0 s0); intros; try congruence.
        consider (fm_lookup st' s0); try contradiction.
        intros. apply pl_equ_symm. auto.
      + specialize (H s).
        consider (string_dec s s0); intros; try congruence.
        consider (fm_lookup st s); intros; try congruence.
        consider (fm_lookup st' s); intros; try congruence.
        apply pl_equ_symm. auto.
  Qed.

  Lemma models_det :
    forall (v : list string) (sst : Syntax.state) (ist ist' : istate),
      models v ist sst -> models v ist' sst ->
      ist ~~ ist'.
  Proof.
    unfold models, states_iso.
    intros.
    specialize (H s). specialize (H0 s).
    consider (In_dec string_dec s v).
    - forward_reason.
      specialize (asReal_det _ _ _ H3 H4).
      intro; subst. rewrite H. rewrite H0. apply pl_equ_symm. auto.
    - forward_reason.
      rewrite H2. rewrite H1. auto.
  Qed.

  (* "progress" in the sense of taking into account the possibility of failure to progress *)
  Lemma embed_ex_correct1 :
    embedding_correct1 embed_ex.
  Proof.
    red.
    simpl. intros.
    exists is. exists is'.
    intuition.
  Qed.

  Lemma embed_ex_correct2 :
    embedding_correct2 embed_ex.
  Proof.
    red.
    intros.
    simpl. intro.
    repeat destruct H1.
    destruct H2.
    apply H0.
    generalize (models_det v ls is x0 H H1); intro Hmf.
    apply states_iso_symm in Hmf.
    generalize eval_det; intro Hed3.
    specialize (Hed3  _ _ _ _ Hmf H3).
    forward_reason.
    eauto.
  Qed.

  Theorem Hoare_Hoare' : forall (P : M.istate -> Prop) (c : M.ast) (Q : M.istate -> Prop), M.Hoare P c Q <-> M.Hoare' P c Q.
  Proof.
    unfold Hoare, Hoare', HoareProgress, HoarePreservation.
    intuition; forward_reason.
    { specialize (H _ H0). destruct H. auto. }
    { specialize (H _ H0). destruct H. auto. }
    { eauto. }
  Qed.
End EmbeddingProofs.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e452m3_17limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition freeze :
  { freeze : feBW_tight -> feBW_limbwidths
  | forall a, phiBW_limbwidths (freeze a) = phiBW_tight a }.
Proof.
  Set Ltac Profiling.
  Time synthesize_freeze ().
  Show Ltac Profile.
Time Defined.

Print Assumptions freeze.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e401m31_8limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition freeze :
  { freeze : feBW_tight -> feBW_limbwidths
  | forall a, phiBW_limbwidths (freeze a) = phiBW_tight a }.
Proof.
  Set Ltac Profiling.
  Time synthesize_freeze ().
  Show Ltac Profile.
Time Defined.

Print Assumptions freeze.


(* $Id: FTC.v,v 1.18 2003/03/13 12:06:18 lcf Exp $ *)

Require Export MoreIntegrals.
Require Export CalculusTheorems.
Require Export PFunct.

Opaque Min.

Section Indefinite_Integral.

(* Tex_Prose
\chapter{The FTC}

Finally we can prove the fundamental theorem of calculus and its most important corollaries---which are the main tools to formalize most of real analysis.

\section{Indefinite Integrals}

We define the indefinite integral of a function in a proper interval in the obvious way; we just need to state a first lemma so that the continuity proofs become unnecessary.

\begin{convention} Let \verb!I:interval!, \verb!F:PartIR! be continuous in \verb!I! and \verb!a! be a point in \verb!I!.
\end{convention}
*)

Variable I:interval.
Variable F:PartIR.

Hypothesis contF:(Continuous I F).

Variable a:IR.
Hypothesis Ha:(iprop I a).

(* Begin_Tex_Verb *)
Lemma prim_lemma : (x:IR)(iprop I x)->
  (Continuous_I (Min_leEq_Max a x) F).
(* End_Tex_Verb *)
Intros.
Elim contF; Intros incI contI.
Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Fprim_strext : (x,y,Hx,Hy:?)
  (((Integral (prim_lemma x Hx))[#](Integral (prim_lemma y Hy)))->
    (x[#]y)).
(* End_Tex_Verb *)
Intros.
Elim (Integral_strext' ????????? H).
Intro; ElimType False.
Generalize a0; Apply ap_irreflexive_unfolded.
Auto.
Qed.

(* Begin_Tex_Verb *)
Definition Fprim : PartIR.
(* End_Tex_Verb *)
Apply Build_PartFunct with pfpfun:=[x:IR][Hx:(iprop I x)](Integral (prim_lemma x Hx)).
Apply iprop_wd.
Exact Fprim_strext.
Defined.

End Indefinite_Integral.

(* Tex_Prose
\begin{notation}
{\tt\hypertarget{Operator_28}{(\{-S-\} contF)}} denotes \verb!(Fprim ?? contF)!.
\end{notation}
*)

Implicits Fprim [1 2].

Notation "{-S-} F" := (Fprim F).

Section FTC.

(* Tex_Prose
\section{The Fundamental Theorem of Calculus}

We can now prove our main theorem.  We begin by remarking that the primitive function is always continuous.

\begin{convention} Assume that \verb!J:interval!, \verb!F:PartIR! is continuous in \verb!J! and \verb!x0! is a point in \verb!J!.  Denote by \verb!G! the indefinite integral of \verb!F! from \verb!x0!.
\end{convention}
*)

Variable J:interval.
Variable F:PartIR.

Hypothesis contF:(Continuous J F).

Variable x0:IR.
Hypothesis Hx0:(iprop J x0).

Local G:=({-S-}contF x0 Hx0).

(* Begin_Tex_Verb *)
Lemma Continuous_prim : (Continuous J G).
(* End_Tex_Verb *)
Split.
Included.
Split.
Included.
Intros.
Simpl; Simpl in H.
Exists e[/]?[//](max_one_ap_zero (Norm_Funct (included_imp_Continuous ?? contF ??? H))).
Apply div_resp_pos.
Apply pos_max_one.
Assumption.
Intros.
Cut (included (Compact (Min_leEq_Max y x)) (Compact Hab)).
Intro Hinc.
Cut (Continuous_I (Min_leEq_Max y x) F); Intros.
Apply leEq_wdl with (AbsIR (Integral H4)).
EApply leEq_transitive.
Apply Integral_leEq_norm.
Apply leEq_transitive with (Max (Norm_Funct (included_imp_Continuous ?? contF ??? H)) One)[*](AbsIR x[-]y).
Apply mult_resp_leEq_rht.
Apply leEq_transitive with (Norm_Funct (included_imp_Continuous ?? contF ??? H)).
Apply leEq_Norm_Funct.
Intros.
Apply norm_bnd_AbsIR.
Apply Hinc; Auto.
Apply lft_leEq_Max.
Apply AbsIR_nonneg.
EApply shift_mult_leEq'.
Apply pos_max_one.
Apply H3.
Apply AbsIR_wd.
RStep ((Integral (prim_lemma J F contF x0 Hx0 y Hy))[+](Integral H4))[-](Integral (prim_lemma J F contF x0 Hx0 y Hy)).
Apply cg_minus_wd.
Apply eq_symmetric_unfolded; Apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x y).
Apply included_imp_Continuous with J; Auto.
Apply included3_interval; Auto.
Apply Integral_wd.
Apply Feq_reflexive.
Apply included_trans with (iprop J); Included.
Apply included_imp_Continuous with J; Auto.
Included.
Included.
Qed.

(* Tex_Prose
The derivative of \verb!G! is simply \verb!F!.
*)

Hypothesis pJ:(proper J).

(* Begin_Tex_Verb *)
Theorem FTC1 : (Derivative J pJ G F).
(* End_Tex_Verb *)
Split; Included.
Split; Included.
Intros; Apply Derivative_I_char.
Included.
Inversion_clear contF.
Included.
Intros.
Red in contF.
Inversion_clear contF.
Elim (contin_prop ???? (H2 ??? H) e H0); Intros d H3 H4.
Exists d.
Assumption.
Intros.
Simpl.
Rename Hab into Hab'.
LetTac Hab:=(less_leEq ??? Hab').
Cut (included (Compact (Min_leEq_Max x y)) (Compact Hab)).
Intro Hinc.
Cut (Continuous_I (Min_leEq_Max x y) F).
2: Apply included_imp_Continuous with J; Auto.
Intro.
Apply leEq_wdl with (AbsIR (Integral H8)[-](Integral (Continuous_I_const ?? (Min_leEq_Max x y) (F x Hx')))).
Apply leEq_wdl with (AbsIR (Integral (Continuous_I_minus ????? H8 (Continuous_I_const ??? (F x Hx'))))).
EApply leEq_transitive.
Apply Integral_leEq_norm.
Apply mult_resp_leEq_rht.
2: Apply AbsIR_nonneg.
Apply leEq_Norm_Funct.
Intros z Hz Hz1.
Simpl.
Apply leEq_wdl with (AbsIR (F z (H1 z (H z (Hinc z Hz))))[-](F x Hx')).
2: Apply AbsIR_wd; Algebra.
Apply H4; Auto.
EApply leEq_transitive.
2: Apply H7.
EApply leEq_wdr.
2: Apply eq_symmetric_unfolded; Apply Abs_Max.
EApply leEq_wdr.
2: Apply AbsIR_eq_x; Apply shift_leEq_minus.
2: Step (Min x y); Apply Min_leEq_Max.
Apply compact_elements with (Min_leEq_Max x y); Auto.
Apply compact_Min_lft.
Apply AbsIR_wd; Apply Integral_minus.
Apply AbsIR_wd; Apply cg_minus_wd.
RStep ((Integral (prim_lemma ?? contF x0 Hx0 ? Hx))[+](Integral H8))[-](Integral (prim_lemma ?? contF x0 Hx0 ? Hx)).
Apply cg_minus_wd.
Apply eq_symmetric_unfolded; Apply Integral_plus_Integral with (Min3_leEq_Max3 x0 y x).
Apply included_imp_Continuous with J; Auto.
Apply included3_interval; Auto.
Apply Integral_wd; Apply Feq_reflexive; Apply included_trans with (iprop J); Try Apply included_interval; Auto.
Apply Integral_const.
Included.
Included.
Qed.

(* Tex_Prose
Any other function \verb!G0! with derivative \verb!F! must differ from \verb!G! by a constant.
*)

Variable G0:PartIR.
Hypothesis derG0:(Derivative J pJ G0 F).

(* Begin_Tex_Verb *)
Theorem FTC2 : {c:IR & (Feq (iprop J) G{-}G0 {-C-}c)}.
(* End_Tex_Verb *)
Apply FConst_prop with pJ.
Apply Derivative_wdr with F{-}F.
FEQ.
Apply Derivative_minus; Auto.
Apply FTC1.
Qed.

(* Tex_Prose
The following is another statement of the Fundamental Theorem of Calculus, often known as Barrow's rule.
*)

Local G0_inc := (Derivative_imp_inc ???? derG0).

(* Begin_Tex_Verb *)
Theorem Barrow : (a,b:IR)(iprop J a)->(iprop J b)->
  (H:(Continuous_I (Min_leEq_Max a b) F))(Ha,Hb:?)
  [Ha':=(G0_inc a Ha)][Hb':=(G0_inc b Hb)]
  (Integral H)[=](G0 b Hb')[-](G0 a Ha').
(* End_Tex_Verb *)
Intros.
Elim FTC2; Intros c Hc.
Inversion_clear Hc.
Inversion_clear H2.
(* Allow G0a to be G0 of a.
Allow G0b to be G0 of b. *)
ttb G0a G0 a; ttb G0b G0 b.
RStepr (G0b[+]c)[-](G0a[+]c).
(* Allow Ga to be G of a.*)
ttb Ga G a. 2: Simpl; Auto.
(* Allow Gb to be G of b.*)
ttb Gb G b. 2: Simpl; Auto.
Apply eq_transitive_unfolded with Gb[-]Ga.
Unfold Ga Gb G; Simpl.
Cut (x,y,z:IR)(z[=]x[+]y)->(y[=]z[-]x); Intros.
Apply H7.
Apply Integral_plus_Integral with (Min3_leEq_Max3 x0 b a).
Apply included_imp_Continuous with J.
Auto.
Apply included3_interval; Auto.
Apply eq_symmetric_unfolded.
RStepr (x[+]y)[-]x; Algebra.
Cut (x,y,z:IR)(x[-]y[=]z)->(x[=]y[+]z); Intros.
Opaque G.
Cut (x:IR)(iprop J x)->(Hx,Hx':?)(G x Hx)[-](G0 x Hx')[=]c; Intros.
Apply cg_minus_wd; Unfold Ga Gb G0a G0b; Apply H7; Auto.
Simpl in H3.
EApply eq_transitive_unfolded.
2: Apply H3 with Hx:=(Hx,Hx').
Algebra.
Auto.
Auto.
RStep y[+](x[-]y).
Algebra.
Qed.

End FTC.

Hints Resolve Continuous_prim : continuous.
Hints Resolve FTC1 : derivate.

Section Limit_of_Integral_Seq.

(* Tex_Prose
\section{Corollaries}

With these tools in our hand, we can prove several useful results.

\begin{convention} From this point onwards:
\begin{itemize}
\item \verb!J:interval!;
\item \verb!f:nat->PartIR! is a sequence of continuous functions (in \verb!J!);
\item \verb!F:PartIR! is continuous in \verb!J!.
\end{itemize}
\end{convention}

In the first place, if a sequence of continuous functions converges then the sequence of their primitives also converges, and the limit commutes with the indefinite integral.
*)

Variable J:interval.

Variable f:nat->PartIR.
Variable F:PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
Hypothesis contF:(Continuous J F).

Section Compact.

(* Tex_Prose
We need to prove this result first for compact intervals.

\begin{convention} Assume that \verb!a,b,x0:IR! with \verb!(f n)! and \verb!F! continuous in $[a,b]$, $x0\in[a,b]$; denote by \verb!(g n)! and \verb!G! the indefinite integrals respectively of \verb!(f n)! and \verb!F! with origin \verb!x0!.
\end{convention}
*)

Variables a,b:IR.
Hypothesis Hab:a[<=]b.
Hypothesis contIf:(n:nat)(Continuous_I Hab (f n)).
Hypothesis contIF:(Continuous_I Hab F).
(* Begin_Tex_Verb *)
Hypothesis convF : (conv_fun_seq' a b Hab f F contIf contIF).
(* End_Tex_Verb *)

Variable x0:IR.
Hypothesis Hx0:(iprop J x0).
Hypothesis Hx0':(Compact Hab x0).

Local g:=[n:nat]({-S-}(contf n) x0 Hx0).
Local G:=({-S-}contF x0 Hx0).

(* Begin_Tex_Verb *)
Hypothesis contg:(n:nat)(Continuous_I Hab (g n)).
Hypothesis contG:(Continuous_I Hab G).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fun_lim_seq_integral :
  (conv_fun_seq' a b Hab g G contg contG).
(* End_Tex_Verb *)
Cut (conv_norm_fun_seq ????? contIf contIF); Intros.
2: Apply conv_fun_seq'_norm; Assumption.
Red; Intros.
Elim (Archimedes (AbsIR b[-]a)[/]?[//](pos_ap_zero ?? H0)); Intros k Hk.
Elim (H k); Intros N HN.
Exists N; Intros.
Cut (included (Compact (Min_leEq_Max x0 x)) (Compact Hab)); [Intro | Apply included2_compact; Auto].
Simpl.
Apply leEq_wdl with (AbsIR (Integral (Continuous_I_minus ?????
  (prim_lemma ?? (contf n) x0 Hx0 ? (contin_imp_inc ???? (contg n) ? Hx))
  (prim_lemma ?? contF x0 Hx0 ? (contin_imp_inc ???? contG ? Hx))))).
2: Apply AbsIR_wd; Apply Integral_minus.
EApply leEq_transitive.
Apply Integral_leEq_norm.
Apply leEq_transitive with (one_div_succ k)[*](AbsIR b[-]a).
Apply mult_resp_leEq_both.
Apply positive_norm.
Apply AbsIR_nonneg.
EApply leEq_transitive.
2: Apply (HN n H1).
Apply leEq_Norm_Funct; Intros.
Apply norm_bnd_AbsIR.
Apply H2; Auto.
Apply compact_elements with Hab; Auto.
Unfold one_div_succ Snring.
RStep (AbsIR b[-]a)[/]?[//](nring_ap_zero ?? (sym_not_eq ??? (O_S k))).
Apply shift_div_leEq.
Apply pos_nring_S.
EApply shift_leEq_mult'.
Assumption.
Apply less_leEq; EApply leEq_less_trans.
Apply Hk.
Simpl.
Apply less_plusOne.
Qed.

End Compact.

(* Tex_Prose
And now we can generalize it step by step.
*)

(* Begin_Tex_Verb *)
Lemma limit_of_integral : (conv_fun_seq'_IR J f F contf contF)->
  (x,y,Hxy:?)(included (Compact Hxy) (iprop J))->(Hf,HF:?)
  (Cauchy_Lim_prop2
    [n:nat](integral x y Hxy (f n) (Hf n))
    (integral x y Hxy F HF)).
(* End_Tex_Verb *)
Intros.
Cut (iprop J x); [Intro Hx | Apply H0; Apply compact_inc_lft].
Cut (iprop J y); [Intro Hy | Apply H0; Apply compact_inc_rht].
LetTac g:=[n:nat]({-S-}(contf n) x Hx).
LetTac G:=({-S-}contF x Hx).
LetTac Hxg:=[n:nat]Hy.
Apply Lim_wd with (Part G y Hy).
Simpl; Apply Integral_integral.
Apply Cauchy_Lim_prop2_wd with [n:nat](Part (g n) y (Hxg n)).
2: Intro; Simpl; Apply Integral_integral.
Cut (n:nat)(Continuous_I Hxy (g n)); Intros.
Cut (Continuous_I Hxy G); Intros.
Apply fun_conv_imp_seq_conv with contf:=H1 contF:=H2.
LetTac H4:=[n:nat](included_imp_Continuous ?? (contf n) ??? H0).
LetTac H5:=(included_imp_Continuous ?? contF ??? H0).
Unfold g G.
Apply fun_lim_seq_integral with H4 H5.
Unfold H4 H5.
Apply H; Auto.
Apply compact_inc_lft.
Apply compact_inc_rht.
Unfold G; Apply included_imp_Continuous with J; Contin.
Unfold g; Apply included_imp_Continuous with J; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma limit_of_Integral : (conv_fun_seq'_IR J f F contf contF)->
  (x,y:IR)(included (Compact (Min_leEq_Max x y)) (iprop J))->
  (Hxy,Hf,HF:?)(Cauchy_Lim_prop2
    [n:nat](!Integral x y Hxy (f n) (Hf n))
    (!Integral x y Hxy F HF)).
(* End_Tex_Verb *)
Intros convF x y.
LetTac x0:=(Min x y).
Intros.
Cut (iprop J x0).
2: Apply H; Apply compact_inc_lft.
Intro Hx0.
Cut (Compact Hxy x0).
2: Apply compact_inc_lft.
Intro Hx0'.
LetTac g:=[n:nat]({-S-}(contf n) x0 Hx0).
LetTac G:=({-S-}contF x0 Hx0).
Unfold Integral; Fold x0.
Apply (Cauchy_Lim_minus [n:nat](integral ???? (Integral_inc2 ???? (Hf n))) [n:nat](integral ???? (Integral_inc1 ???? (Hf n)))); Fold x0.
Apply limit_of_integral with Hf:=[n:nat](Integral_inc2 ?? Hxy ? (Hf n)); Auto.
Apply included_trans with (Compact (Min_leEq_Max x y)); Included.
Apply included_compact.
Apply compact_inc_lft.
Apply compact_Min_rht.
Apply limit_of_integral with Hf:=[n:nat](Integral_inc1 ?? Hxy ? (Hf n)); Auto.
Apply included_trans with (Compact (Min_leEq_Max x y)); Auto.
Apply included_compact.
Apply compact_inc_lft.
Apply compact_Min_lft.
Qed.

Section General.

(* Tex_Prose
Finally, with \verb!x0,g,G! as before,
*)

(* Begin_Tex_Verb *)
Hypothesis convF : (conv_fun_seq'_IR J f F contf contF).
(* End_Tex_Verb *)

Variable x0:IR.
Hypothesis Hx0:(iprop J x0).

Local g:=[n:nat]({-S-}(contf n) x0 Hx0).
Local G:=({-S-}contF x0 Hx0).

Hypothesis contg:(n:nat)(Continuous J (g n)).
Hypothesis contG:(Continuous J G).

(* Begin_Tex_Verb *)
Lemma fun_lim_seq_integral_IR :
  (conv_fun_seq'_IR J g G contg contG).
(* End_Tex_Verb *)
Red; Intros.
Unfold g G.
Cut (iprop J a); Intros.
LetTac h:=[n:nat]{-C-}(Integral (prim_lemma ?? (contf n) x0 Hx0 a H)).
LetTac g':=[n:nat](h n){+}({-S-}(contf n) a H).
LetTac G':={-C-}(Integral (prim_lemma ?? contF x0 Hx0 a H)){+}({-S-}contF a H).
Cut (n:nat)(Continuous_I Hab (h n)); Intros.
2: Unfold h; Contin.
Cut (n:nat)(Continuous_I Hab ({-S-}(contf n) a H)); Intros.
Cut (n:nat)(Continuous_I Hab (g' n)); Intros.
2: Unfold g'; Contin.
Cut (Continuous_I Hab ({-S-}contF a H)); Intros.
Cut (Continuous_I Hab G'); Intros.
2: Unfold G'; Contin.
Apply conv_fun_seq'_wdl with g' H2 (included_imp_Continuous ?? contG ??? Hinc).
Intro; FEQ.
Simpl.
Apply eq_symmetric_unfolded; Apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a).
Apply included_imp_Continuous with J; Contin.
Apply conv_fun_seq'_wdr with H2 G' H4.
FEQ.
Simpl.
Apply eq_symmetric_unfolded; Apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a).
Apply included_imp_Continuous with J; Contin.
Unfold g' G'.
Apply conv_fun_seq'_wdl with f:=g' contf:=[n:nat](Continuous_I_plus ????? (H0 n) (H1 n)) contF:=H4.
Unfold g' in H2.
Intro; Apply Feq_reflexive; Included.
Unfold g' G'.
Apply (fun_Lim_seq_plus' ?? Hab h [n:nat]({-S-}(contf n) a H) H0 H1 ??
  (Continuous_I_const ??? (Integral (prim_lemma ?? contF x0 Hx0 a H))) H3).
Unfold h.
Apply seq_conv_imp_fun_conv with x:=[n:nat](Integral (prim_lemma ?? (contf n) x0 Hx0 a H)).
Apply limit_of_Integral with Hf:=[n:nat](prim_lemma ?? (contf n) x0 Hx0 a H); Auto.
Included.
Apply fun_lim_seq_integral with [n:nat](included_imp_Continuous ?? (contf n) ??? Hinc) (included_imp_Continuous ?? contF ??? Hinc).
Apply convF; Auto.
Apply compact_inc_lft.
Apply included_imp_Continuous with J; Contin.
Apply included_imp_Continuous with J; Contin.
Apply Hinc; Apply compact_inc_lft.
Qed.

End General.

End Limit_of_Integral_Seq.

Section Limit_of_Derivative_Seq.

(* Tex_Prose
Similar results hold for the sequence of derivatives of a converging sequence; this time the proof is easier, as we can do it directly for any kind of interval.

\begin{convention} Let \verb!g! be the sequence of derivatives of \verb!f! and \verb!G! be the derivative of \verb!F!.
\end{convention}
*)

Variable J:interval.
Hypothesis pJ:(proper J).

Variables f,g:nat->PartIR.
Variables F,G:PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
Hypothesis contF:(Continuous J F).
Hypothesis convF : (conv_fun_seq'_IR J f F contf contF).

Hypothesis contg:(n:nat)(Continuous J (g n)).
Hypothesis contG:(Continuous J G).
Hypothesis convG : (conv_fun_seq'_IR J g G contg contG).

Hypothesis derf:(n:nat)(Derivative J pJ (f n) (g n)).

(* Begin_Tex_Verb *)
Lemma fun_lim_seq_derivative : (Derivative J pJ F G).
(* End_Tex_Verb *)
Elim (nonvoid_point ? (proper_nonvoid ? pJ)); Intros a Ha.
LetTac h:=[n:nat]({-S-}(contg n) a Ha).
LetTac H:=({-S-}contG a Ha).
Cut (Derivative J pJ H G).
2: Unfold H; Apply FTC1.
Intro.
Cut (n:nat)(Derivative J pJ (h n) (g n)).
2: Intro; Unfold h; Apply FTC1.
Intro.
Cut (conv_fun_seq'_IR J ?? [n:nat](Derivative_imp_Continuous ???? (H1 n)) (Derivative_imp_Continuous ???? H0)).
2: Unfold h H.
2: EApply fun_lim_seq_integral_IR with contf:=contg; Auto.
Intro.
Cut {c:IR & (Feq (iprop J) F{-}H {-C-}c)}.
Intro.
Elim H3; Clear H3; Intros c Hc.
Apply Derivative_wdl with H{+}{-C-}c.
Apply Feq_transitive with H{+}(F{-}H).
Apply Feq_plus.
Apply Feq_reflexive; Included.
Apply Feq_symmetric; Assumption.
Clear Hc H2 H1; ClearBody H.
FEQ.
Apply Derivative_wdr with G{+}{-C-}Zero.
FEQ.
Apply Derivative_plus; Auto.
Apply Derivative_const.
Cut (n:nat){c:IR & (Feq (iprop J) (f n){-}(h n) {-C-}c)}; Intros.
2: Apply FConst_prop with pJ.
2: Cut (Derivative J pJ (f n) (g n)); [Intro | Auto].
2: Cut (Derivative J pJ (h n) (g n)); [Intro | Auto].
2: Apply Derivative_wdr with (g n){-}(g n).
2: FEQ.
2: Apply Derivative_minus; Auto.
Cut (n:nat)(Continuous J (f n){-}(h n)); [Intro contw | Unfold h; Contin].
Cut (Continuous J F{-}H); [Intro contW | Unfold H; Contin].
Apply fun_const_Lim with [n:nat](f n){-}(h n) contw contW.
Auto.
EApply fun_Lim_seq_minus'_IR.
Apply convF.
Apply H2.
Assumption.
Qed.

End Limit_of_Derivative_Seq.

Section Derivative_Series.

(* Tex_Prose
As a very important case of this result, we get a rule for deriving series.
*)

Variable J:interval.
Hypothesis pJ:(proper J).
Variables f,g:nat->PartIR.

(* Begin_Tex_Verb *)
Hypothesis convF:(fun_series_convergent_IR J f).
Hypothesis convG:(fun_series_convergent_IR J g).
(* End_Tex_Verb *)
Hypothesis derF:(n:nat)(Derivative J pJ (f n) (g n)).

(* Begin_Tex_Verb *)
Lemma Derivative_FSeries :
  (Derivative J pJ (FSeries_Sum convF) (FSeries_Sum convG)).
(* End_Tex_Verb *)
Apply fun_lim_seq_derivative with
  f:=[n:nat](FSum0 n f)
  contf:=(Continuous_Sum0 ?? (convergent_imp_Continuous ?? convF))
  contF:=(Continuous_FSeries_Sum ?? convF)
  g:=[n:nat](FSum0 n g)
  contg:=(Continuous_Sum0 ?? (convergent_imp_Continuous ?? convG))
  contG:=(Continuous_FSeries_Sum ?? convG).
3: Deriv.
Apply FSeries_conv.
Apply FSeries_conv.
Qed.

End Derivative_Series.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e521m1_10limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition freeze :
  { freeze : feBW_tight -> feBW_limbwidths
  | forall a, phiBW_limbwidths (freeze a) = phiBW_tight a }.
Proof.
  Set Ltac Profiling.
  Time synthesize_freeze ().
  Show Ltac Profile.
Time Defined.

Print Assumptions freeze.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.arrival_sequence prosa.classic.model.arrival.basic.task prosa.classic.model.arrival.basic.task_arrival prosa.classic.model.arrival.basic.job.
Require Import prosa.classic.implementation.uni.susp.dynamic.task
               prosa.classic.implementation.uni.susp.dynamic.job.
From mathcomp Require Import ssreflect ssrbool ssrfun ssrnat eqtype seq div.

Module ConcreteArrivalSequence.

  Import Job ArrivalSequence ConcreteTask ConcreteJob SporadicTaskset TaskArrival.

  Section PeriodicArrivals.

    Variable ts: concrete_taskset.

    (* At any time arr_time, we release Some job of tsk if t is a multiple of the period,
       otherwise we release None. *)
    Definition add_job (arr_time: time) (tsk: concrete_task) :=
      if task_period tsk %| arr_time  then
        Some (Build_concrete_job (arr_time %/ task_period tsk) arr_time
                                 (task_cost tsk) (task_deadline tsk) tsk)
      else
        None.

    (* The arrival sequence at any time t is simply the partial map of add_job. *)
    Definition periodic_arrival_sequence (t: time) := pmap (add_job t) ts.

  End PeriodicArrivals.

  Section Proofs.

    (* Let ts be any concrete task set with valid parameters. *)
    Variable ts: concrete_taskset.
    Hypothesis H_valid_task_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.

    (* Regarding the periodic arrival sequence built from ts, we prove that...*)
    Let arr_seq := periodic_arrival_sequence ts.

    (* ... arrival times are consistent, ... *)
    Theorem periodic_arrivals_are_consistent:
      arrival_times_are_consistent job_arrival arr_seq.
    Proof.
      move => j t ARRj.
      rewrite /arrives_at mem_pmap in ARRj.
      move: ARRj => /mapP ARRj; destruct ARRj as [tsk IN SOME].
      by unfold add_job in *; desf.
    Qed.

    (* ... every job comes from the task set, ... *)
    Theorem periodic_arrivals_all_jobs_from_taskset:
      forall j,
        arrives_in arr_seq j ->
        job_task j \in ts.
    Proof.
      move => j [t ARRj].
      rewrite mem_pmap in ARRj.
      move: ARRj => /mapP ARRj; destruct ARRj as [tsk IN SOME].
      by unfold add_job in *; desf.
    Qed.

    (* ..., jobs have valid parameters, ... *)
    Theorem periodic_arrivals_valid_job_parameters:
      forall j,
        arrives_in arr_seq j ->
        valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.
    Proof.
      rename H_valid_task_parameters into PARAMS.
      unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
      move => j [t ARRj].
      rewrite mem_pmap in ARRj; move: ARRj => /mapP [tsk IN SOME].
      unfold add_job in SOME; desf.
      specialize (PARAMS tsk IN); des.
      unfold valid_sporadic_job, valid_realtime_job, job_cost_positive.
      by repeat split; try (by done); apply leqnn.
    Qed.

    (* ... job arrivals satisfy the sporadic task model, ... *)
    Theorem periodic_arrivals_are_sporadic:
      sporadic_task_model task_period job_arrival job_task arr_seq.
    Proof.
      move => j j' /eqP DIFF [arr ARR] [arr' ARR'] SAMEtsk LE.
      rewrite eqE /= /job_eqdef negb_and /= SAMEtsk eq_refl orbF in DIFF.
      rewrite 2!mem_pmap in ARR ARR'.
      move: ARR ARR' => /mapP [tsk_j INj SOMEj] /mapP [tsk_j' INj' SOMEj'].
      unfold add_job in SOMEj, SOMEj'; desf; simpl in *;
      move: Heq0 Heq => /dvdnP [k DIV] /dvdnP [k' DIV'].
      {
        rewrite DIV DIV' -mulSnr.
        rewrite leq_eqVlt in LE; move: LE => /orP [/eqP EQ | LESS].
        {
          exfalso; move: DIFF => /negP DIFF; apply DIFF.
          by subst; rewrite EQ !eq_refl.
        }
        subst; rewrite leq_mul2r; apply/orP; right.
        by rewrite ltn_mul2r in LESS; move: LESS => /andP [_ LT].
      }
    Qed.

    (* ... and the arrival sequence has no duplicate jobs. *)
    Theorem periodic_arrivals_is_a_set:
      arrival_sequence_is_a_set arr_seq.
    Proof.
      intros t.
      unfold arr_seq, periodic_arrival_sequence.
      apply (pmap_uniq) with (g := job_task); last by destruct ts.
      by unfold add_job, ocancel; intro tsk; desf.
    Qed.

  End Proofs.

End ConcreteArrivalSequence.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e468m17_8limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition freeze :
  { freeze : feBW_tight -> feBW_limbwidths
  | forall a, phiBW_limbwidths (freeze a) = phiBW_tight a }.
Proof.
  Set Ltac Profiling.
  Time synthesize_freeze ().
  Show Ltac Profile.
Time Defined.

Print Assumptions freeze.


Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import omega.Omega.
Require Import Setoid.
Require Import ZArith.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Local Open Scope struct_scope.

Require Import FinProof.CommonProofs.
Require Import depoolContract.ProofEnvironment.
Require Import depoolContract.DePoolClass.
Require Import depoolContract.SolidityNotations.

Require Import depoolContract.DePoolFunc.
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

Require Import depoolContract.Lib.CommonModelProofs.
Module CommonModelProofs := CommonModelProofs StateMonadSig.
Import CommonModelProofs.
Require Import depoolContract.Lib.Tactics.
Require Import depoolContract.Lib.ErrorValueProofs.
(*Require Import depoolContract.Lib.CommonCommon.*)
(* Require Import depoolContract.Lib.tvmFunctionsProofs. *)
Require Export depoolContract.Scenarios.Common.CommonDefinitions.

Import DePoolSpec.LedgerClass.SolidityNotations.

Local Open Scope struct_scope.
Local Open Scope Z_scope.
Local Open Scope solidity_scope.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

Set Typeclasses Iterative Deepening.
Set Typeclasses Depth 100.

Inductive Projection_Round_Stakes_State :=
| _Projection_Round_Stakes_State :
    Z (*stake*) ->
    Z (*recoveredStake*) ->
    Z (*unused*) ->
    bool (*isValidatorStakeCompleted*) ->
    Z (*rewards*) ->
    Z (*validatorStake*) ->
    Z (*handledStakesAndRewards*) ->
    Projection_Round_Stakes_State.

Definition getProjectionRoundStakesState (r : RoundsBase_ι_Round) :=
    _Projection_Round_Stakes_State
    (RoundsBase_ι_Round_ι_stake r)
    (RoundsBase_ι_Round_ι_recoveredStake r)
    (RoundsBase_ι_Round_ι_unused r)
    (RoundsBase_ι_Round_ι_isValidatorStakeCompleted r)
    (RoundsBase_ι_Round_ι_rewards r)
    (RoundsBase_ι_Round_ι_validatorStake r)
    (RoundsBase_ι_Round_ι_handledStakesAndRewards r).

Definition projection_round_stakes_getStake (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State x _ _ _ _ _ _ => x
    end.

Definition projection_round_stakes_getRecoveredStake (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ x _ _ _ _ _ => x
    end.

Definition projection_round_stakes_getUnused (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ _ x _ _ _ _ => x
    end.

Definition projection_round_stakes_getIsValidatorStakeCompleted (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ _ _ x _ _ _ => x
    end.

Definition projection_round_stakes_getRewards (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ _ _ _ x _ _ => x
    end.

Definition projection_round_stakes_getValidatorStake (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ _ _ _ _ x _ => x
    end.

Definition projection_round_stakes_getHandledStakesAndRewards (prc : Projection_Round_Stakes_State) :=
    match prc with
    | _Projection_Round_Stakes_State _ _ _ _ _ _ x => x
    end.


From Coqprime Require Import PocklingtonRefl.
Local Open Scope positive_scope.

Lemma primo118:
  prime  4704087594993277409->
  prime  538448682474459892391929.
Proof.
intro H.
apply (Pocklington_refl
     (Ell_certif
      538448682474459892391929
      114464
      ((4704087594993277409,1)::nil)
      100
      0
      20
      100)
     ((Proof_certif _ H) :: nil)).
native_cast_no_check (refl_equal true).
Time Qed.


Require Import Coq.Bool.Bool.
Require Import Equivalence.
Require Import ExtLib.Core.RelDec.

Class Lte T := { lte : T -> T -> Prop }.
Definition neg_lte {T} {L:Lte T} (x:T) (y:T) : Prop := not (lte x y).

Definition lt {T} {L:Lte T} x y := lte x y /\ ~lte y x.
Definition neg_lt {T} {L:Lte T} x y := not (lt x y).

Instance lt_RelDec {T} {L:Lte T} {RD:RelDec lte} : RelDec lt :=
  { rel_dec x y := (rel_dec x y && negb (rel_dec y x))%bool }.

Instance lt_RelDecCorrect {T} {L:Lte T} {RD:RelDec lte} {RDC:RelDec_Correct RD}
  : RelDec_Correct lt_RelDec := { rel_dec_correct := _ }.
Proof. intros ; constructor ; intros.
  unfold rel_dec in H. simpl in H. apply andb_true_iff in H. destruct H.
    unfold lt. constructor. apply rel_dec_correct. auto.
    apply neg_rel_dec_correct. simpl in H0.
    apply negb_true_iff in H0. auto.
  unfold lt in H. destruct H. unfold rel_dec. simpl. apply andb_true_iff.
    constructor. apply rel_dec_correct. auto.
    apply negb_true_iff. apply neg_rel_dec_correct. auto.
Qed.

Class LteWF T :=
{ lteWFLte :> Lte T
; lteWFPreOrder :> PreOrder lte
}.

Instance LteWF_Build {T} {L:Lte T} {PO:PreOrder lte} : LteWF T :=
  { lteWFLte := L ; lteWFPreOrder := PO }.

Definition lte_dec {T} {L:Lte T} {R:RelDec lte} := rel_dec.
Definition neg_lte_dec {T} {L:Lte T} {R:RelDec lte} x y := negb (lte_dec x y).

Definition lt_dec {T} {L:Lte T} {R:RelDec lte} := rel_dec.
Definition neg_lt_dec {T} {L:Lte T} {R:RelDec lte} x y := negb (lt_dec x y).

Section dec_p.
  Context {T} {L:Lte T} {RD:RelDec lte} {DC:RelDec_Correct RD}.

  Definition lte_dec_p (x:T) (y:T) : {lte x y} + {~lte x y} := rel_dec_p x y.
  Definition neg_lte_dec_p (x:T) (y:T) : {~lte x y} + {lte x y} := neg_rel_dec_p x y.
  Definition lt_dec_p (x:T) (y:T) : {lt x y} + {~lt x y} := rel_dec_p x y.
  Definition neg_lt_dec_p (x:T) (y:T) : {~lt x y} + {lt x y} := neg_rel_dec_p x y.
End dec_p.

Module LteNotation.
  Notation "x <=! y"       := (lte_dec x y)
    (at level 35, no associativity).
  Notation "x <=! y <=! z" := (lte_dec x y /\ lte_dec y z)
    (at level 35, y at next level, no associativity).
  Notation "x >=! y"       := (lte_dec y x)
    (at level 35, no associativity, only parsing).
  Notation "x >=! y >=! z" := (lte_dec z y /\ lte_dec y x)
    (at level 35, y at next level, no associativity).

  Notation "x <! y"       := (lt_dec x y)
    (at level 35, no associativity).
  Notation "x <! y <! z"  := (lt_dec x y /\ lt_dec y z)
    (at level 35, y at next level, no associativity).
  Notation "x >! y"       := (lt_dec y x)
    (at level 35, no associativity, only parsing).
  Notation "x >! y >! z"  := (lt_dec z y /\ lt_dec y x)
    (at level 35, y at next level, no associativity).

  Notation "x <=? y"       := (lte_dec_p y x)
    (at level 35, no associativity).
  Notation "x <=? y <=? z" := (lte_dec_p x y /\ lte_dec_p y z)
    (at level 35, y at next level, no associativity).
  Notation "x >=? y"       := (lte_dec_p y x)
    (at level 35, no associativity, only parsing).
  Notation "x >=? y >=? z" := (lte_dec_p z y /\ lte_dec_p y x)
    (at level 35, y at next level, no associativity, only parsing).

  Notation "x <? y"       := (lt_dec_p y x)
    (at level 35, no associativity).
  Notation "x <? y <? z"  := (lt_dec_p x y /\ lt_dec_p y z)
    (at level 35, y at next level, no associativity).
  Notation "x >? y"       := (lt_dec_p y x)
    (at level 35, no associativity, only parsing).
  Notation "x >? y >? z"  := (lt_dec_p z y /\ lt_dec_p y x)
    (at level 35, y at next level, no associativity, only parsing).

  Notation "x <=. y"       := (lte x y)
    (at level 70, no associativity).
  Notation "x <=. y <=. z" := (lte x y /\ lte y z)
    (at level 70, y at next level, no associativity).
  Notation "x >=. y"       := (lte y x)
    (at level 70, no associativity, only parsing).
  Notation "x >=. y >=. z" := (lte z y /\ lte y x)
    (at level 70, y at next level, no associativity, only parsing).

  Notation "x <. y"       := (lt x y)
    (at level 70, no associativity).
  Notation "x <. y <. z" := (lt x y /\ lt y z)
    (at level 70, y at next level, no associativity).
  Notation "x >. y"       := (lt y x)
    (at level 70, no associativity, only parsing).
  Notation "x >. y >. z" := (lt z y /\ lt y x)
    (at level 70, y at next level, no associativity, only parsing).
End LteNotation.


Require Import Crypto.

Inductive protoType : Type :=
| Send : type -> protoType -> protoType
| Receive : type -> protoType -> protoType
| Choice : protoType -> protoType -> protoType
| Offer : protoType -> protoType -> protoType
| Eps : type -> protoType.

Inductive protoExp : protoType -> Type :=
| SendC {t:type} {p':protoType}  : (message t) -> (protoExp p')
    -> protoExp (Send t p')
| ReceiveC {t:type} {p':protoType} : ((message t)->(protoExp p'))
                                     -> protoExp (Receive t p')
| ChoiceC (b:bool) {r s:protoType} : (protoExp r) -> (protoExp s)
    -> (protoExp (Choice r s))
| OfferC {r s : protoType} : (protoExp r) -> (protoExp s)
                                        -> protoExp (Offer r s)
| ReturnC {t:type} : (message t) -> protoExp (Eps t).

Fixpoint returnType (pt : protoType) : type :=
  match pt with
  | Eps t => t
  | Send _ pt' => returnType pt'
  | Receive _ pt' => returnType pt'
  | Choice pt' pt'' => Either (returnType pt') (returnType pt'')
  | Offer pt' pt'' => Either (returnType pt') (returnType pt'')
  end.

Notation "x :!: y" := (Send x y)
                        (at level 50, left associativity).
Notation "x :!: y" := (protoExp (Send x y))
                        (at level 50, left associativity).

Notation "x :?: y" := (Receive x y)
                        (at level 50, left associativity).
Notation "x :?: y" := (protoExp (Receive x y))
                        (at level 50, left associativity).

Notation "x :+: y" := (Choice x y)
                        (at level 50, left associativity).
Notation "x :+: y" := (protoExp (Choice x y))
                        (at level 50, left associativity).

Notation "x :&: y" := (Offer x y)
                        (at level 50, left associativity).
Notation "x :&: y" := (protoExp (Offer x y))
                        (at level 50, left associativity).

Notation "'send' n ; p" := (SendC n p)
                            (right associativity, at level 60).
Notation "x <- 'receive' ; p " := (ReceiveC (fun x => p))
                                    (right associativity, at level 60).

Notation "'offer'" := OfferC.

Notation "'choice'" := ChoiceC.

Definition EpsC := ReturnC (basic 0).

Fixpoint DualT (t t':protoType) : Prop :=
  match t with
  | Send p1T p1' =>
    match t' with
    | Receive p2T p2' => (p1T = p2T) /\ (DualT p1' p2')
    | _ => False
    end
  | Receive p1T p1' =>
    match t' with
    | Send p2T p2' => (p1T = p2T) /\ (DualT p1' p2')
    | _ => False
    end
  | Choice p1' p1'' =>
    match t' with
    | Offer p2' p2'' => (DualT p1' p2') /\ (DualT p1'' p2'')
    | _ => False
    end
  | Offer p1' p1'' =>
    match t' with
    | Choice p2' p2'' => (DualT p1' p2') /\ (DualT p1'' p2'')
    | _ => False
    end
  | Eps _ =>
    match t' with
    | Eps _ => True
    | _ => False
    end
  end.

Fixpoint DualT_dec (t t':protoType) : {DualT t t'} + {~ DualT t t'}.
Proof.
  destruct t; destruct t';

  (* Eliminate all un-interesting cases *)
  try (right; unfold not; intros; inversion H; contradiction);

  (* For the Send/Receive, Receive/Send cases *)
  try (
  destruct (eq_type_dec t t1); destruct (DualT_dec t0 t');
  try (right; unfold not; intros; inversion H; contradiction);
  try (left; split; assumption)
  );

  (* For the Choice/Offer, Offer/Choice cases *)
  try (
  destruct (DualT_dec t1 t'1); destruct (DualT_dec t2 t'2);
  try (right; unfold not; intros; inversion H; contradiction);
  try( left; split; assumption)
    ).

  (* Eps/Eps case *)
  left. simpl. trivial.

Defined.

Definition Dual {t t':protoType} (p1:protoExp t) (p2:protoExp t') : Prop := DualT t t'.