(*
 This is the definition of formal syntax for Dan Grossman's Thesis,
  "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".

 This defines the static semantics of statements and expressions, pg. 63.

*)

Set Implicit Arguments.
Require Export Cyclone_Dynamic_Semantics_Heap_Objects.
Require Export Cyclone_Static_Semantics_Typing_Heap_Objects.
Require Export Cyclone_Static_Semantics_Kinding_And_Context_Well_Formedness.
Close Scope list_scope.
Import LibEnvNotations.
Import LVPE.LibVarPathEnvNotations.

Inductive ret : St -> Prop :=
| ret_ret       : forall (e : E),
                       ret (retn e)

| ret_if        : forall (e : E) (s1 s2 : St),
                       ret s1 ->
                       ret s2 ->
                       ret (if_s e s1 s2)

| ret_seq_1     : forall (s s' : St),
                       ret s ->
                       ret (seqx s s')

| ret_seq_2     : forall (s s' : St),
                       ret s' ->
                       ret (seqx s s')

| ret_let       : forall (e : E) (s : St),
                       ret s ->
                       ret (letx e s)

| ret_open      : forall (e : E) (s : St),
                       ret s ->
                       ret (openx e s)

| ret_openstar  : forall (e : E) (s : St),
                       ret s ->
                       ret (openstar e s).
Hint Constructors ret.

Inductive styp : Delta -> Upsilon -> Gamma -> St -> Tau -> Prop :=
  | styp_e_3_1    : forall (d : Delta) (u : Upsilon) (g : Gamma)
                           (tau: Tau) (e : E),
                      rtyp d u g e  tau ->
                      styp d u g (e_s e) tau

(* This is correct, return at end of program. *)
  | styp_return_3_2 : forall (d : Delta) (u : Upsilon) (g : Gamma)
                             (tau : Tau) (e : E),
                         rtyp d u g e tau ->
                         styp d u g (retn e) tau

  | styp_seq_3_3    : forall (d : Delta) (u : Upsilon) (g : Gamma)
                             (tau : Tau) (s1 s2 : St),
                         styp d u g s1 tau ->
                         styp d u g s2 tau ->
                         styp d u g (seqx s1 s2) tau

  | styp_if_3_5     :  forall (d : Delta) (u : Upsilon) (g : Gamma)
                              (tau : Tau) (e: E) (s1 s2 : St),
                          rtyp d u g e cint ->
                          styp d u g s1 tau ->
                          styp d u g s2 tau ->
                          styp d u g (if_s e s1 s2) tau

  | styp_while_3_4  : forall (d : Delta) (u : Upsilon) (g : Gamma)
                             (tau : Tau) (e: E) (s : St),
                         rtyp d u g e cint ->
                         styp d u g s tau ->
                         styp d u g (while e s) tau

  | styp_let_3_6    :  forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma)
                               (tau tau' : Tau)
                               (s : St) (e : E),
                          (forall (x : var),
                            x \notin L ->
                            styp d u (g & (x ~ tau')) (TM.open_rec_st 0 x s) tau) ->
                            rtyp d u g e tau' ->
                            K d tau' A ->  (* Thesis change. *)
                            styp d u g (letx e s) tau

  | styp_open_3_7   :  forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma)
                               (k : Kappa) (tau tau' : Tau)
                               (s : St) (e : E),
                         (forall (x : var) (alpha : var),
                             x \notin L ->
                             alpha \notin L ->
                             styp ((alpha ~ k) & d)
                                  u
                                  (g & (x ~ (T.open_rec 0 (ftvar alpha) tau')))
                                  (TTM.open_rec_st 0 (ftvar alpha)
                                                   (TM.open_rec_st 0 x s))
                                  tau) ->
                         rtyp d u g e tau' ->
                         K d tau A      ->
                         styp d u g (openx e s) tau

  | styp_openstar_3_8 :  forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma)
                               (k : Kappa) (tau tau' : Tau)
                               (s : St) (e : E),
                         (forall (x : var) (alpha : var),
                             x \notin L ->
                             alpha \notin L ->
                             styp (d & (alpha ~ k))
                                  u
                                  (g & (x ~ (T.open_rec 0 (ftvar alpha) (ptype tau'))))
                                  (TTM.open_rec_st 0 (ftvar alpha)
                                                   (TM.open_rec_st 0 x s))
                                  tau) ->
                          ltyp d u g e tau' ->
                          K d tau A      ->
                          styp d u g (openstar e s) tau

with      ltyp :   Delta -> Upsilon -> Gamma -> E -> Tau -> Prop :=

  | SL_3_1     : forall (d : Delta) (g : Gamma) (u : Upsilon)
                           (x : var) (p : Path) (tau tau': Tau),
                      binds x tau' g ->
                      (* get x g = Some tau' -> *)
                      gettype u x nil tau' p tau ->
                      WFC d u g ->
                      K d tau' A ->
                      ltyp d u g (p_e (fevar x) p) tau

  | SL_3_2     : forall (d : Delta) (u : Upsilon) (g : Gamma)
                        (e : E) (tau : Tau) ,
                      rtyp d u g e (ptype tau) ->
                      K d tau A ->
                      ltyp d u g (star e) tau

  | SL_3_3     : forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E) (t0 t1 : Tau),
                      ltyp d u g e (cross t0 t1) ->
                      ltyp d u g (dot e zero_pe) t0

  | SL_3_4     : forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E) (t0 t1 : Tau),
                      ltyp d u g e (cross t0 t1) ->
                      ltyp d u g (dot e one_pe) t1

with      rtyp :  Delta -> Upsilon -> Gamma -> E   -> Tau -> Prop :=
  | SR_3_1  : forall (d : Delta) (g : Gamma) (u : Upsilon)
                        (x  : var) (p : Path) (tau tau': Tau),
                   binds x tau' g ->
                   (* get x g = Some tau' ->  *)
                   gettype u x nil tau' p tau ->
                   K d tau' A ->
                   WFC d u g ->
                   rtyp d u g (p_e (fevar x) p) tau

  | SR_3_2  :  forall (e : E) (tau : Tau)
                      (d : Delta) (u : Upsilon) (g : Gamma),
                    rtyp d u g e (ptype tau) ->
                    K d tau A ->
                    rtyp d u g (star e) tau

  | SR_3_3  :  forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E) (t0 t1 : Tau),
                        rtyp d u g e (cross t0 t1) ->
                        rtyp d u g (dot e zero_pe) t0

  | SR_3_4  : forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E) (t0 t1 : Tau),
                      rtyp d u g e (cross t0 t1) ->
                      rtyp d u g (dot e one_pe) t1

  | SR_3_5  : forall (d : Delta) (u : Upsilon) (g : Gamma) (n : nat),
                   WFC d u g ->
                   rtyp d u g (i_e (i_i n)) cint

  | SR_3_6  : forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E) (tau : Tau),
                   ltyp d u g e tau ->
                   rtyp d u g (amp e) (ptype tau)

  | SR_3_7  : forall (d : Delta) (u : Upsilon) (g : Gamma) (e0 e1: E) (t0 t1 : Tau),
                   rtyp d u g e0 t0 ->
                   rtyp d u g e1 t1 ->
                   rtyp d u g (cpair e0 e1) (cross t0 t1)

  | SR_3_8  : forall (d : Delta) (u : Upsilon) (g : Gamma) (e1 e2 : E) (tau : Tau),
                   ltyp d u g e1 tau ->
                   rtyp d u g e2 tau ->
                   ASGN d tau    ->
                   rtyp d u g (assign e1 e2) tau

  | SR_3_9  : forall (d : Delta) (u : Upsilon) (g : Gamma) (e1 e2 : E) (tau tau' : Tau),
                   rtyp d u g e1 (arrow tau' tau) ->
                   rtyp d u g e2 tau' ->
                   rtyp d u g (appl e1 e2) tau

  | SR_3_10 : forall (d : Delta) (u : Upsilon) (g : Gamma) (tau : Tau) (s : St),
                   styp d u g s tau ->
                   ret s ->
                   rtyp d u g (call s) tau

  | SR_3_11 : forall (d : Delta) (u : Upsilon) (g : Gamma) (e : E)
                        (tau tau' tau'': Tau) (k : Kappa),
                   rtyp d u g e (utype k tau') ->
                   AK   d tau k ->
                   (T.open_rec 0 tau tau') = tau'' ->
                   rtyp d u g (inst e tau) tau''

  | SR_3_12 : forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma) (e : E)
                        (tau tau': Tau) (k : Kappa) (p : Phi),
               (forall (alpha : var),
                   alpha \notin L ->
                   rtyp d u g e (T.open_rec 0 tau' tau)) ->
                   K    d (etype p k tau) A ->
                   AK   d tau' k ->
                   rtyp d u g (pack tau' e (etype p k tau))
                              (etype p k tau)

  | SR_3_13 : forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma) (tau tau': Tau)
                     (s : St),
               (forall (x : var),
                   x \notin L ->
                   styp d u (g & (x ~ tau)) (TM.open_rec_st 0 x s) tau') ->
                   ret s ->
                   rtyp d u g (f_e (dfun tau tau' s)) (arrow tau tau')

  | SR_3_14 : forall (L : vars) (d : Delta) (u : Upsilon) (g : Gamma) (f : F)
                        (tau : Tau) (k : Kappa),
                 (forall alpha,
                     alpha \notin L ->
                     rtyp (d & (alpha ~ k)) u g (f_e (TTM.open_rec_f 0 (ftvar alpha) f))
                          (T.open_rec 0 (ftvar alpha) tau)) ->
                   WFC  d u g ->
                   rtyp d u g (f_e (ufun k f)) (utype k tau).

Scheme styp_ind_mutual := Induction for styp Sort Prop
with   ltyp_ind_mutual := Induction for ltyp Sort Prop
with   rtyp_ind_mutual := Induction for rtyp Sort Prop.
Combined Scheme typ_ind_mutual from
          styp_ind_mutual, ltyp_ind_mutual, rtyp_ind_mutual.

Hint Constructors styp.
Hint Constructors rtyp.
Hint Constructors ltyp.
Hint Extern 6 (rtyp _ _       (?E & (?x ~ ?t')) (p_e (fevar ?x) nil) ?t') =>
idtac "find_tau" t';
apply SR_3_1 with (tau':= t'); auto.

Inductive htyp: Upsilon -> Gamma -> Heap -> Gamma -> Prop :=
   | htyp_empty : forall (u : Upsilon) (g: Gamma),
                       htyp u g hdot gdot

   | htyp_xv    : forall (u : Upsilon) (g g' g'': Gamma) (h h': Heap) (x : var)
                         (v : E) (tau : Tau),
                      Value v ->
                      (* Question is this env hacking right ? *)
                      (* Arthur works from the right. *)
                      htyp u g (h & h') (g' & g'') ->
                      rtyp ddot u g v tau ->
                      htyp u g (h & (x ~ v) & h') (g' & (x ~ tau) & g'').
Hint Constructors htyp.

Inductive refp  : Heap -> Upsilon -> Prop :=
  | refp_empty  : forall (h : Heap),
                       refp h udot

  | refp_pack  : forall (h : Heap) (u : Upsilon) (x : var) (p : Path)
                        (tau tau' : Tau) (k : Kappa) (v v' : E),
                      binds x v' h ->
                      (* get x h = Some v' ->  *)
                      get' v' p (pack tau' v (etype aliases k tau)) ->
                      refp h u ->
                      refp h (u &p ((x,p) ~p tau')).
Hint Constructors refp.

(* This has an arbitrary return type due to Dan's style. So it is not syntax directed. *)
Inductive prog  : Heap -> St -> Prop :=
  | program  : forall (h : Heap) (u : Upsilon) (g : Gamma) (tau : Tau) (s : St),
                    htyp u g h g ->
                    refp h u     ->
                    styp ddot u g s tau ->
                    ret s ->
                    prog h s.
Hint Constructors prog.


Require Import Coq.Lists.List.
Require Import MirrorShard.ExprUnify.
Require Import MirrorShard.SepHeap.
Require Import MirrorShard.Expr.

Set Implicit Arguments.
Set Strict Implicit.

Module Make (SUBST : Instantiation.Subst)
            (ST : SepTheory.SepTheory) (SE : SepExpr.SepExpr ST)
            (SH : SepHeap ST SE).
  Module SH_FACTS := SepHeapFacts ST SE SH.
  Import SH_FACTS.

  Section typed.
    Variable types : list type.
    Variable s : SUBST.Subst types.

    Definition impuresInstantiate : MM.mmap (exprs types) -> MM.mmap (exprs types) :=
      MM.mmap_map (map (@SUBST.exprInstantiate _ s)).

    Definition sheapInstantiate (h : SH.SHeap types) : SH.SHeap types :=
      {| SH.impures := impuresInstantiate (SH.impures h)
       ; SH.pures   := map (@SUBST.exprInstantiate _ s) (SH.pures h)
       ; SH.other   := SH.other h
       |}.

    Variable funcs : functions types.
    Variable preds : SE.predicates types.

    Variables U G : env types.

    Lemma impuresInstantiate_mmap_add : forall n e acc, SE.heq funcs preds U G
        (SH.impuresD (impuresInstantiate (MM.mmap_add n e acc)))
        (SH.impuresD
          (MM.mmap_add n (map (@SUBST.exprInstantiate _ s) e)
                         (impuresInstantiate acc))).
    Proof.
      clear. intros. eapply MM.PROPS.map_induction with (m := acc); intros.
      { unfold MM.mmap_add, impuresInstantiate, MM.mmap_map.
        repeat rewrite MF.find_Empty by auto using MF.map_Empty.
        rewrite SH.impuresD_Equiv. reflexivity.
        rewrite MF.map_add. simpl.
        reflexivity. }
      { unfold MM.mmap_add, impuresInstantiate, MM.mmap_map.
        rewrite MF.FACTS.map_o. simpl in *. unfold exprs in *. case_eq (FM.find n m'); simpl; intros.
        { rewrite SH.impuresD_Equiv. reflexivity.
          rewrite MF.map_add. reflexivity. }
        { rewrite SH.impuresD_Equiv. reflexivity.
          rewrite MF.map_add. simpl. reflexivity. } }
    Qed.

    Lemma sheapInstantiate_Equiv : forall a b,
      MM.mmap_Equiv a b ->
      MM.mmap_Equiv (impuresInstantiate a) (impuresInstantiate b).
    Proof.
      clear. unfold impuresInstantiate, MM.mmap_Equiv, MM.mmap_map, FM.Equiv; intuition;
      try solve [ repeat match goal with
                           | [ H : FM.In _ (FM.map _ _) |- _ ] => apply MF.FACTS.map_in_iff in H
                           | [ |- FM.In _ (FM.map _ _) ] => apply MF.FACTS.map_in_iff
                         end; firstorder ].
      repeat match goal with
               | [ H : FM.MapsTo _ _ (FM.map _ _) |- _ ] =>
                 apply MF.FACTS.map_mapsto_iff in H; destruct H; intuition; subst
             end.
      apply Permutation.Permutation_map. firstorder.
    Qed.

    Lemma sheapInstantiate_add : forall n e m m',
      ~FM.In n m ->
      MM.PROPS.Add n e m m' ->
      SE.heq funcs preds U G
        (SH.impuresD (impuresInstantiate m'))
        (SH.starred (fun v => SE.Func n (map (SUBST.exprInstantiate s) v)) e
          (SH.impuresD (impuresInstantiate m))).
    Proof.
      clear. intros.
        unfold impuresInstantiate, MM.mmap_map.
        rewrite SH.impuresD_Add with (i := FM.map (map (map (SUBST.exprInstantiate s))) m) (f := n) (argss := map (map (SUBST.exprInstantiate s)) e).
        symmetry; rewrite SH.starred_base. heq_canceler.
        repeat rewrite SH.starred_def.
        match goal with
          | [ |- context [ @SE.Emp ?X ] ] => generalize (@SE.Emp X)
        end.
        clear. induction e; simpl; intros; try reflexivity.
        rewrite IHe. heq_canceler.

        red. intros. specialize (H0 y). repeat (rewrite MM.FACTS.add_o in * || rewrite MM.FACTS.map_o in * ).
        unfold exprs in *. rewrite H0. unfold MM.FACTS.option_map. destruct (MF.FACTS.eq_dec n y); auto.

        intro. apply H. apply MM.FACTS.map_in_iff in H1. auto.
    Qed.

    Lemma applyD_forget_exprInstantiate :
      SUBST.Subst_equations funcs U G s ->
      forall D R F l,
        applyD (exprD funcs U G) D (map (SUBST.exprInstantiate s) l) R F =
        applyD (exprD funcs U G) D l R F.
    Proof.
      clear. induction D; destruct l; simpl; auto.
      rewrite SUBST.Subst_equations_exprInstantiate; eauto.
      destruct (exprD funcs U G e a); eauto.
    Qed.

    Lemma starred_forget_exprInstantiate : forall x P,
      SUBST.Subst_equations funcs U G s ->
      forall e,
      SE.heq funcs preds U G
        (SH.starred (fun v : list (expr types) => SE.Func x (map (SUBST.exprInstantiate s) v)) e P)
        (SH.starred (SE.Func x) e P).
    Proof.
      clear. induction e; intros; repeat rewrite SH.starred_def; simpl; repeat rewrite <- SH.starred_def; SEP_FACTS.heq_canceler.
        rewrite IHe. SEP_FACTS.heq_canceler. unfold SE.heq. simpl.
        match goal with
                 | [ |- context [ match ?X with _ => _ end ] ] =>
                   case_eq X; intros; try reflexivity
               end.
        erewrite applyD_forget_exprInstantiate with (D := SE.SDomain p) (F := SE.SDenotation p); eauto.
        reflexivity.
    Qed.

    Lemma impuresD_forget_impuresInstantiate : forall h,
      SUBST.Subst_equations funcs U G s ->
      SE.heq funcs preds U G
        (SH.impuresD (impuresInstantiate h))
        (SH.impuresD h).
    Proof.
      clear. intros. eapply MM.PROPS.map_induction with (m := h); intros.
      { unfold sheapInstantiate, MM.mmap_map. repeat rewrite SH.impuresD_Empty; eauto using MF.map_Empty. reflexivity. }
      { rewrite sheapInstantiate_add; eauto. rewrite SH.starred_base. symmetry.
        rewrite SH.impuresD_Add; eauto. rewrite <- H0. SEP_FACTS.heq_canceler.
        rewrite starred_forget_exprInstantiate; auto. reflexivity. }
    Qed.

    Lemma Func_forget_exprInstantiate : forall n e,
      SUBST.Subst_equations funcs U G s ->
      SE.heq funcs preds U G (SE.Func n (map (SUBST.exprInstantiate s) e)) (SE.Func n e).
    Proof. clear.
      unfold SE.heq. simpl. intros.
      destruct (nth_error preds n); try reflexivity.
      rewrite applyD_forget_exprInstantiate; auto. reflexivity.
    Qed.

  End typed.

End Make.


Require Import Raft.
Require Import RaftRefinementInterface.
Require Import RefinementCommonDefinitions.

Section CandidateEntriesInterface.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition leaderLogs_candidateEntries net :=
    (forall h e t ll,
       In (t, ll) (leaderLogs (fst (nwState net h))) ->
       In e ll ->
       candidateEntries e (nwState net)).

  Class leaderLogs_candidate_entries_interface : Prop :=
    {
      leaderLogs_candidate_entries_invariant :
        forall (net : network),
          refined_raft_intermediate_reachable net ->
          leaderLogs_candidateEntries net
    }.
End CandidateEntriesInterface.


From Coqprime Require Import PocklingtonRefl.
Local Open Scope positive_scope.
Require Import  p2_0.
Require Import  p2_1.
Require Import  p2_2.
Require Import  p2_3.
Require Import  p2_4.
Require Import  p2_5.
Require Import  p2_6.
Require Import  p2_7.
Require Import  p2_8.
Require Import  p2_9.
Require Import  p2_10.
Require Import  p2_11.
Require Import  p2_12.
Require Import  p2_13.
Require Import  p2_14.
Require Import  p2_15.
Require Import  p2_16.
Require Import  p2_17.
Require Import  p2_18.
Require Import  p2_19.
Require Import  p2_20.
Require Import  p2_21.
Require Import  p2_22.
Require Import  p2_23.
Require Import  p2_24.
Require Import  p2_25.
Require Import  p2_26.
Require Import  p2_27.
Require Import  p2_28.
Require Import  p2_29.
Require Import  p2_30.
Require Import  p2_31.
Require Import  p2_32.
Require Import  p2_33.
Require Import  p2_34.
Require Import  p2_35.
Require Import  p2_36.
Require Import  p2_37.
Require Import  p2_38.
Require Import  p2_39.
Require Import  p2_40.
Require Import  p2_41.
Require Import  p2_42.
Require Import  p2_43.

Lemma  primo: prime 114789617297051243807394853655940577550383949836485463237927811686022851893642440579491908283323734110690123218402162834248300171023376927031645173423205135545585977038016109116491415747402838951704714962416997985799541881883556637387455242464836313863532607376482559785175545647914460814186015677784006924001.
Proof.
exact
(primo0 (primo1 (primo2 (primo3 (primo4 (primo5 (primo6 (primo7 (primo8 (primo9 (primo10 (primo11 (primo12 (primo13 (primo14 (primo15 (primo16 (primo17 (primo18 (primo19 (primo20 (primo21 (primo22 (primo23 (primo24 (primo25 (primo26 (primo27 (primo28 (primo29 (primo30 (primo31 (primo32 (primo33 (primo34 (primo35 (primo36 (primo37 (primo38 (primo39 (primo40 (primo41 (primo42 primo43))))))))))))))))))))))))))))))))))))))))))).
Qed.