From mathcomp.ssreflect Require Import ssreflect seq ssrbool.
Require Import compcert.common.Memory.
Require Import compcert.common.AST.     (*for typ*)
Require Import compcert.common.Values. (*for val*)
Require Import compcert.common.Globalenvs.
Require Import compcert.lib.Integers.

Require Import msl.Axioms.
Require Import Coq.ZArith.ZArith.
Require Import sepcomp.semantics.
Require Import sepcomp.event_semantics.
Require Export concurrency.semantics.
Require Import concurrency.threadPool. Export threadPool.

Require Import concurrency.machine_semantics.
Require Import concurrency.permissions.
Require Import concurrency.bounded_maps.
Require Import concurrency.addressFiniteMap.

Require Import concurrency.scheduler.
Require Import Coq.Program.Program.

Require Import concurrency.safety.

Require Import concurrency.coinductive_safety.

Notation EXIT :=
  (EF_external "EXIT" (mksignature (AST.Tint::nil) None)).

Notation CREATE_SIG := (mksignature (AST.Tint::AST.Tint::nil) None cc_default).
Notation CREATE := (EF_external "spawn" CREATE_SIG).

Notation READ :=
  (EF_external "READ"
               (mksignature (AST.Tint::AST.Tint::AST.Tint::nil) (Some AST.Tint) cc_default)).
Notation WRITE :=
  (EF_external "WRITE"
               (mksignature (AST.Tint::AST.Tint::AST.Tint::nil) (Some AST.Tint) cc_default)).

Notation MKLOCK :=
  (EF_external "makelock" (mksignature (AST.Tint::nil) None cc_default)).
Notation FREE_LOCK :=
  (EF_external "freelock" (mksignature (AST.Tint::nil) None cc_default)).

Notation LOCK_SIG := (mksignature (AST.Tint::nil) None cc_default).
Notation LOCK := (EF_external "acquire" LOCK_SIG).
Notation UNLOCK_SIG := (mksignature (AST.Tint::nil) None cc_default).
Notation UNLOCK := (EF_external "release" UNLOCK_SIG).

Module Type EventSig.
  Declare Module TID: ThreadID.
  Import TID.

  Definition evRes := (access_map * access_map)%type.
  Definition evDelta := (delta_map * delta_map)%type.

  Inductive sync_event : Type :=
  | release : address (*-> option (evRes * evDelta)*) -> option evRes -> sync_event
  | acquire : address (*-> option (evRextes * evDelta)*) -> option evDelta -> sync_event
  | mklock :  address -> sync_event
  | freelock : address -> sync_event
  | spawn : address -> option (evRes * evDelta) -> option evDelta -> sync_event
  | failacq: address -> sync_event.

  Inductive machine_event : Type :=
  | internal: TID.tid -> mem_event -> machine_event
  | external : TID.tid -> sync_event -> machine_event.

End EventSig.

Module Type ConcurrentMachineSig.
  Declare Module ThreadPool: ThreadPoolSig.
  Declare Module Events: EventSig.
  Import ThreadPool.
  Import Events.
  Import SEM.

  Notation thread_pool := ThreadPool.t.
  (** Memories*)
  Parameter richMem: Type.
  Parameter dryMem: richMem -> mem.
  Parameter diluteMem : mem -> mem.

  (** Environment and Threadwise semantics *)
  (** These values come from SEM *)

  (** The thread pool respects the memory*)
  Parameter mem_compatible: thread_pool -> mem -> Prop.
  Parameter invariant: thread_pool -> Prop.

  (** Step relations *)
  Parameter threadStep:
    G -> forall {tid0 ms m},
      containsThread ms tid0 -> mem_compatible ms m ->
      thread_pool -> mem -> seq mem_event -> Prop.
  Axiom threadStep_equal_run:
    forall g i tp m cnt cmpt tp' m' tr,
      @threadStep g i tp m cnt cmpt tp' m' tr ->
      forall j,
        (exists cntj q, @getThreadC j tp cntj = Krun q) <->
        (exists cntj' q', @getThreadC j tp' cntj' = Krun q').
  Parameter syncStep:
    bool -> (* if it's a Coarse machine. Temp solution to propagating changes. *)
    G -> forall {tid0 ms m},
      containsThread ms tid0 -> mem_compatible ms m ->
      thread_pool -> mem -> sync_event -> Prop.

  Axiom syncstep_equal_run:
    forall b g i tp m cnt cmpt tp' m' tr,
      @syncStep b g i tp m cnt cmpt tp' m' tr ->
      forall j,
        (exists cntj q, @getThreadC j tp cntj = Krun q) <->
        (exists cntj' q', @getThreadC j tp' cntj' = Krun q').

  Axiom syncstep_not_running:
    forall b g i tp m cnt cmpt tp' m' tr,
      @syncStep b g i tp m cnt cmpt tp' m' tr ->
      forall cntj q, ~ @getThreadC i tp cntj = Krun q.

  Parameter threadHalted:
    forall {tid0 ms},
      containsThread ms tid0 -> Prop.

  Axiom threadHalt_update:
    forall i j, i <> j ->
      forall tp cnt cnti c' cnt',
        (@threadHalted j tp cnt) <->
        (@threadHalted j (@updThreadC i tp cnti c') cnt') .

  Axiom syncstep_equal_halted:
    forall b g i tp m cnti cmpt tp' m' tr,
      @syncStep b g i tp m cnti cmpt tp' m' tr ->
      forall j cnt cnt',
        (@threadHalted j tp cnt) <->
        (@threadHalted j tp' cnt').

  Axiom threadStep_not_unhalts:
    forall g i tp m cnt cmpt tp' m' tr,
      @threadStep g i tp m cnt cmpt tp' m' tr ->
      forall j cnt cnt',
        (@threadHalted j tp cnt) ->
        (@threadHalted j tp' cnt') .

  (*Parameter initial_machine: C -> thread_pool.*)

  Parameter init_mach : option RES.res  -> G -> val -> list val -> option thread_pool.

End ConcurrentMachineSig.

Module Type ConcurrentMachine.
  Declare Module SCH: Scheduler.
  Declare Module TP: ThreadPoolSig.
  Declare Module SIG: ConcurrentMachineSig with Module ThreadPool:= TP.

  Import SCH.
  Import TP.
  Import SIG.Events.

  Notation event_trace := (seq machine_event).

  Definition MachState : Type:= (schedule * event_trace * t)%type.

  Parameter MachineSemantics: schedule -> option RES.res ->
                              CoreSemantics SIG.ThreadPool.SEM.G MachState mem.

  Axiom initial_schedule: forall genv main vals U U' p c tr,
      initial_core (MachineSemantics U p) genv main vals = Some (U',tr,c) ->
      U' = U /\ tr = nil.
End ConcurrentMachine.

Module CoarseMachine (SCH:Scheduler)(SIG : ConcurrentMachineSig with Module ThreadPool.TID:=SCH.TID with Module Events.TID :=SCH.TID) <: ConcurrentMachine with Module SCH:= SCH with Module TP:= SIG.ThreadPool  with Module SIG:= SIG.
  Module SCH:=SCH.
  Module TP:=SIG.ThreadPool.
  Module SIG:=SIG.
  Import SCH SIG TID ThreadPool ThreadPool.SEM Events.

  Notation Sch:=schedule.
  Notation machine_state := ThreadPool.t.

  Notation event_trace := (seq machine_event).

  (** Resume and Suspend: threads running must be preceded by a Resume
     and followed by Suspend.  This functions wrap the state to
     indicate it's ready to take a syncronisation step or resume
     running. (This keeps the invariant that at most one thread is not
     at_external) *)

  Inductive start_thread' genv: forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | StartThread: forall tid0 ms ms' c_new vf arg
                    (ctn: containsThread ms tid0)
                    (Hcode: getThreadC ctn = Kinit vf arg)
                    (Hinitial: initial_core Sem genv vf (arg::nil) = Some c_new)
                    (Hinv: invariant ms)
                    (Hms': updThreadC ctn (Krun c_new)  = ms'),
      start_thread' genv ctn ms'.
  Definition start_thread genv: forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @start_thread' genv.
  Inductive resume_thread': forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | ResumeThread: forall tid0 ms ms' c c' X
                    (ctn: containsThread ms tid0)
                    (Hat_external: at_external Sem c = Some X)
                    (Hafter_external: after_external Sem None c = Some c')
                    (Hcode: getThreadC ctn = Kresume c Vundef)
                    (Hinv: invariant ms)
                    (Hms': updThreadC ctn (Krun c')  = ms'),
      resume_thread' ctn ms'.
  Definition resume_thread: forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @resume_thread'.

  Inductive suspend_thread': forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | SuspendThread: forall tid0 ms ms' c X
                     (ctn: containsThread ms tid0)
                     (Hcode: getThreadC ctn = Krun c)
                     (Hat_external: at_external Sem c = Some X)
                     (Hinv: invariant ms)
                     (Hms': updThreadC ctn (Kblocked c) = ms'),
      suspend_thread' ctn ms'.
  Definition suspend_thread : forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @suspend_thread'.

  Inductive machine_step {genv:G}:
    Sch -> event_trace -> machine_state -> mem -> Sch ->
    event_trace -> machine_state -> mem -> Prop :=
  | start_step:
      forall tid U ms ms' m
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: start_thread genv Htid ms'),
        machine_step U [::] ms m U [::] ms' m
  | resume_step:
      forall tid U ms ms' m
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: resume_thread Htid ms'),
        machine_step U [::] ms m U [::] ms' m
  | thread_step:
      forall tid U ms ms' m m' ev
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: threadStep genv Htid Hcmpt ms' m' ev),
        machine_step U [::] ms m U [::] ms' m'
  | suspend_step:
      forall tid U U' ms ms' m
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep:suspend_thread Htid ms'),
        machine_step U [::] ms m U' [::] ms' m
  | sync_step:
      forall tid U U' ms ms' m m' ev
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: syncStep true genv Htid Hcmpt ms' m' ev),
        machine_step U [::] ms m  U' [::] ms' m'
  | halted_step:
      forall tid U U' ms m
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Hinv: invariant ms)
        (Hhalted: threadHalted Htid),
        machine_step U [::] ms m  U' [::] ms m
  | schedfail :
      forall tid U U' ms m
        (HschedN: schedPeek U = Some tid)
        (Htid: ~ containsThread ms tid)
        (Hinv: invariant ms)
        (HschedS: schedSkip U = U'),        (*Schedule Forward*)
        machine_step U [::] ms m U' [::] ms m.

  (*Lemma to deal with the trivial trace*)
  Lemma trace_nil: forall ge U tr st m U' tr' st' m',
      @machine_step ge U tr st m U' tr' st' m' ->
  tr = nil /\ tr' = nil.
  Proof. move=> ge U tr st m U' tr' st' m' ms; inversion ms; intuition. Qed.

  (*The new semantics bellow makes internal (thread) and external (machine) steps explicit*)
  Inductive internal_step {genv:G}:
    Sch -> machine_state -> mem -> machine_state -> mem -> Prop :=
  | thread_step':
      forall tid U ms ms' m m' ev
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: threadStep genv Htid Hcmpt ms' m' ev),
        internal_step U ms m ms' m'.

  Inductive external_step  {genv:G}:
    Sch -> event_trace -> machine_state -> mem -> Sch ->
    event_trace -> machine_state -> mem -> Prop :=
  | start_state': forall tid U ms ms' m
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: start_thread genv Htid ms'),
        external_step U [::] ms m U [::] ms' m
  | resume_step':
      forall tid U ms ms' m
        (HschedN: schedPeek U = Some tid)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: resume_thread Htid ms'),
        external_step U [::] ms m U [::] ms' m
  | suspend_step':
      forall tid U U' ms ms' m
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep:suspend_thread Htid ms'),
        external_step U [::] ms m U' [::] ms' m
  | sync_step':
      forall tid U U' ms ms' m m' ev
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: syncStep true genv Htid Hcmpt ms' m' ev),
        external_step U [::] ms m  U' [::] ms' m'
  | halted_step':
      forall tid U U' ms m
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Hinv: invariant ms)
        (Hhalted: threadHalted Htid),
        external_step U [::] ms m  U' [::] ms m
  | schedfail':
      forall tid U U' ms m
        (HschedN: schedPeek U = Some tid)
        (Htid: ~ containsThread ms tid)
        (Hinv: invariant ms)
        (HschedS: schedSkip U = U'),        (*Schedule Forward*)
        external_step U [::] ms m U' [::] ms m.
  (*Symmetry*)
  (* These steps are basically the same: *)
  Lemma step_equivalence1: forall ge U tr st m U' tr' st' m',
    @machine_step ge U tr st m U' tr' st' m' ->
    (U=U' /\ tr = tr' /\  @internal_step ge U st m st' m') \/
    @external_step ge U tr st m U' nil st' m'.
  Proof.
    move=> ge U tr st m U' tr' st' m' ms.
    inversion ms;
      first[ solve [ left; repeat split=>//; econstructor; eauto] |
             solve[right; econstructor; eauto]].
  Qed.
  Lemma step_equivalence2: forall ge U st m st' m',
      @internal_step ge U st m st' m' ->
      @machine_step ge U nil st m U nil st' m'.
  Proof. move=>  ge U st m st' m' istp.
         by inversion istp; econstructor; eauto.
  Qed.
   Lemma step_equivalence3: forall ge U tr st m U' tr' st' m',
      @external_step ge U tr st m U' tr' st' m' ->
      @machine_step ge U tr st m U' tr' st' m'.
   Proof. move=>  ge U tr st m U' nil st' m' estp.
          inversion estp;
          [
              solve[econstructor 1 ; eauto]|
              solve[econstructor 2 ; eauto]|
              solve[econstructor 4 ; eauto]|
              solve[econstructor 5 ; eauto]|
              solve[econstructor 6 ; eauto]|
              solve[econstructor 7 ; eauto]].
   Qed.

  Definition MachState: Type := (Sch * event_trace * machine_state)%type.

  Definition MachStep G (c:MachState) (m:mem)
             (c' :MachState) (m':mem) :=
    @machine_step G (fst (fst c)) (snd (fst c)) (snd c)  m
                  (fst (fst c')) (snd (fst c')) (snd c')  m'.

  Definition at_external (st : MachState)
    : option (external_function * list val) := None.

  Definition after_external (ov : option val) (st : MachState) :
    option (MachState) := None.

  (*not clear what the value of halted should be*)
  (*Nick: IMO, the machine should be halted when the schedule is empty.
            The value is probably unimportant? *)
  (*Santiago: I belive empty schedule should "diverge". After all that's *)
  Definition halted (st : MachState) : option val :=
    match schedPeek (fst (fst st)) with
    | Some _ => None
    | _ => Some Vundef
    end.

  (*Lemma halted_al_schedules: forall st,
      halted st ->*)

  Definition init_machine (U:schedule) (r : option RES.res) the_ge
             (f : val) (args : list val)
    : option MachState :=
    match init_mach r the_ge f args with
    | None => None
    | Some c => Some (U, [::], c)
    end.

  Program Definition MachineSemantics (U:schedule) (r : option RES.res):
    CoreSemantics G MachState mem.
  intros.
  apply (@Build_CoreSemantics _ MachState _
                              (init_machine U r)
                              at_external
                              after_external
                              halted
                              MachStep
        );
    unfold at_external, halted; try reflexivity.
  intros. inversion H; subst; rewrite HschedN; reflexivity.
  auto.
  Defined.

  Definition init_machine' (r : option RES.res) the_ge
             (f : val) (args : list val)
    : option (machine_state) :=
    match init_mach r the_ge f args with
    | None => None
    | Some c => Some (c)
    end.

  (*This is not used anymore:
   * find_thread
   * running_thread *)
  Definition find_runnin (c:@ctl C): bool :=
    match c with
    | Krun _ => true
    | _ => false
    end.
  Definition running_thread: machine_state -> option tid:=
    fun st => find_thread st find_runnin.

    Definition unique_Krun tp i :=
     forall j cnti q,
       @getThreadC j tp cnti = Krun q ->
       ~ @threadHalted j tp cnti  ->
       eq_tid_dec i j.

  Program Definition new_MachineSemantics (U:schedule) (r : option RES.res):
    @ConcurSemantics G tid schedule event_trace machine_state mem.
  apply (@Build_ConcurSemantics _ tid schedule event_trace  machine_state _
                              (init_machine' r)
                              (fun U st => halted (U, nil, st))
                              (fun ge U st m st' m' =>
                                 @internal_step ge U st m
                                                st' m'
                              )
                              (fun ge U (tr:event_trace) st m U' tr' st' m' =>
                                 @external_step ge U tr st m
                                                U' tr' st' m'
                              )
                              unique_Krun
                              (*fun A => running_thread A*))
         ;
    unfold at_external, halted; try reflexivity.
  - intros. inversion H; subst; rewrite HschedN; reflexivity.
  - intros. inversion H; subst; rewrite HschedN; reflexivity.
  Defined.

(*
  Definition MachineSemantics:= MachineSemantics'.*)
  Lemma initial_schedule: forall genv main vals U U' p c tr,
      initial_core (MachineSemantics U p) genv main vals = Some (U',tr,c) ->
      U' = U /\ tr = nil.
        simpl. unfold init_machine. intros.
        destruct (init_mach p genv main vals); try solve[inversion H].
        inversion H; subst; split; auto.
  Qed.

  Lemma corestep_empty_trace: forall genv U tr tr' c m c' m' U',
      MachStep genv (U,tr,c) m (U', tr', c') m' ->
      tr = nil /\ tr' = nil.
  Proof.
    intros.
    inversion H; subst; simpl in *; auto.
  Qed.

  (** Schedule safety of the coarse-grained machine*)
  Inductive csafe (ge : G) (st : MachState) (m : mem) : nat -> Prop :=
  | Safe_0: csafe ge st m 0
  | HaltedSafe: forall n, halted st -> csafe ge st m n
  | CoreSafe : forall tp' m' n
                 (Hstep: MachStep ge st m (fst (fst st),[::],tp') m')
                 (Hsafe: csafe ge (fst (fst st),[::],tp') m' n),
      csafe ge st m (S n)
  | AngelSafe: forall tp' m' n
                 (Hstep: MachStep ge st m (schedSkip (fst (fst st)),[::],tp') m')
                 (Hsafe: forall U'', csafe ge (U'',[::],tp') m' n),
      csafe ge st m (S n).

  Section new_safety.
  (** *I create a new type of safety that satisfies (forall n, safeN) -> safe and is preserved by simulations. *)

    Inductive sem_with_halt ge: MachState -> mem -> MachState -> mem -> Prop:=
    | halt_with_step st m: halted st -> sem_with_halt ge st m st m
    | step_with_halt st m st' m' : MachStep ge st m st' m' -> sem_with_halt ge st m st' m'.

  Definition new_state: Type:= seq machine_event * machine_state * mem.
  Definition mk_nstate (st:MachState) m:new_state:= (snd (fst st), snd st, m).
  Definition mk_ostate (st:new_state) U :MachState:= (U, fst (fst st), snd (fst st)).
  Definition new_step ge (st: new_state) U st' U': Prop:=
    sem_with_halt ge (mk_ostate st U) (snd st) (mk_ostate st' U') (snd st').

  (*Definition valid (st: MachState): Prop:=
    match (running_thread (snd st)), (schedPeek (fst (fst st))) with
    | _, None => True
    | None, _ => True
    | Some a, Some b => eq_tid_dec a b (* || containsThread_dec b (snd st) *)
    end.*)

  Section valid_schedule.

    Definition is_running tp i:=
      exists cnti q, @getThreadC i tp cnti = Krun q /\ ~ @threadHalted i tp cnti.

    Lemma unique_runing_not_running:
      forall tp i,
        unique_Krun tp i ->
        is_running tp i \/
        forall j, unique_Krun tp j.
    Proof.
      unfold unique_Krun, is_running.
      intros.
      destruct (Classical_Prop.classic
                  (exists (cnti : containsThread tp i) (q : C),
                      getThreadC cnti = Krun q /\ ~ threadHalted cnti))
        as [[cnti [q [KRUN Not_HALTED]]] | NO]; [left|right].
      + exists cnti, q; auto.
      + intros j j0 cnti q KRUN NOT_HALTED.
        specialize (H _ _ _ KRUN NOT_HALTED).
        destruct (eq_tid_dec i j0); try solve[inversion H].
        subst i.
        exfalso; apply NO.
        exists cnti, q; split; assumption.
    Qed.

    Corollary unique_runing_not_running':
      forall tp i,
        unique_Krun tp i ->
        ~ is_running tp i ->
        forall j, unique_Krun tp j.
    Proof.
      intros. destruct (unique_runing_not_running _ _ H).
      - contradict H0; assumption.
      - apply H1.
    Qed.

  Lemma no_running_one_running:
    forall tp,
      (forall j, unique_Krun tp j) ->
      forall i cnti c, unique_Krun (@updThreadC i tp cnti (Krun c)) i.
  Proof.
    unfold unique_Krun.
    intros.
    destruct (eq_tid_dec i j); auto; exfalso; eapply n.
    erewrite <- (gsoThreadCC _ (cntUpdateC' cnti0)) in H0; auto.
    eapply H with (j:=i) in H0.
    destruct (eq_tid_dec i j); inversion H0; assumption.
    intros HH; apply H1.
    eapply threadHalt_update in HH; eauto.
    Grab Existential Variables.
    assumption.
  Qed.
  Lemma one_running_no_running:
    forall tp i,
      (unique_Krun tp i) ->
      forall j cnti c, unique_Krun (@updThreadC i tp cnti (Kblocked c)) j.
  Proof.
    unfold unique_Krun.
    intros.
    destruct (eq_tid_dec i j0).
    - subst i.
      rewrite (gssThreadCC cnti0) in H0; inversion H0.
    - rewrite <- (gsoThreadCC n (cntUpdateC' cnti0)) in H0.
      eapply H with (j:=j0) in H0.
      exfalso; apply n;
      destruct (eq_tid_dec i j0); auto; inversion H0.
      intros HH; apply H1.
      eapply threadHalt_update in HH; eauto.
  Qed.

  Lemma no_running_no_running:
    forall tp,
      (forall h, unique_Krun tp h ) ->
      forall i j cnti c, unique_Krun (@updThreadC i tp cnti (Kblocked c)) j.
  Proof.
    unfold unique_Krun.
    intros.
    destruct (eq_tid_dec i j0).
    - subst i.
      rewrite (gssThreadCC cnti0) in H0; inversion H0.
    - rewrite <- (gsoThreadCC n (cntUpdateC' cnti0)) in H0.
      eapply H with (j:=j0) in H0.
      eassumption.
      intros HH; apply H1.
      eapply threadHalt_update in HH; eauto.
  Qed.

  End valid_schedule.

  Definition correct_schedule(st: MachState): Prop:=
    match schedPeek (fst (fst st)) with
    | Some i => unique_Krun (snd st) i
    | None => True
    end.

  Definition valid (st: MachState): Prop:=
    correct_schedule st.

  Definition bounded_mem (m: mem) := bounded_maps.bounded_map (snd (getMaxPerm m)) .

  Definition new_valid st U := correct_schedule (mk_ostate st U).
  Definition new_valid_bound st U :=
    correct_schedule (mk_ostate st U) /\ bounded_mem (snd st).
  Definition ksafe_new_step (ge : G) (st : MachState) (m : mem) : nat -> Prop :=
    ksafe _ _ (new_step ge) new_valid (mk_nstate st m) (fst (fst st)).
  Definition safe_new_step (ge : G) (st : MachState) (m : mem) : Prop :=
    safe _ _ (new_step ge) new_valid (mk_nstate st m) (fst (fst st)).
  Definition safe_new_step_bound (ge : G) (st : MachState) (m : mem) : Prop :=
    safe _ _ (new_step ge) new_valid_bound (mk_nstate st m) (fst (fst st)).

  (*Things that we must prove:*)
  Lemma sch_dec': forall (U U': Sch), {U = U'} + {U <> U'}.
  Proof. apply SCH.sch_dec. Qed.
  Lemma step_sch: forall {ge U tr tp m U' tr' tp' m'}, MachStep ge (U, tr, tp) m (U', tr', tp') m' -> U=U' \/ schedSkip(U)=U'.
  Proof.
    intros.
    inversion H;
      simpl in *;
      subst; first[left; reflexivity | right; reflexivity | idtac].
  Qed.
  Lemma step_trace: forall {ge U tr tp m U' tr' tp' m'}, MachStep ge (U, tr, tp) m (U', tr', tp') m' -> nil = tr'.
  Proof.
    intros.
    inversion H;
      simpl in *; auto.
  Qed.
  (*Most cases in this proof are similar. Should automate!*)
  Lemma step_sch_correct: forall {ge st m st' m'}, MachStep ge st m st' m'  -> correct_schedule st -> correct_schedule st'.
  Proof.
    unfold correct_schedule in *.
    intros.
    destruct st as [[a b] c]; destruct st' as [[a' b' ] c'].
    inversion H; subst; simpl in *.
    - inversion Htstep; subst.
      rewrite HschedN in H0; rewrite HschedN.
      eapply no_running_one_running.
      destruct (unique_runing_not_running _ _ H0) as [HH | HH]; auto.
      destruct HH as [cnt' [c' [KRUN NOT_HALTED]]].
      pose (@gLockSetCode tid0 c).
      replace cnt' with ctn in KRUN.
      + rewrite Hcode in KRUN; inversion KRUN.
      + eapply msl.Axioms.proof_irr.
    - inversion Htstep; subst.
      rewrite HschedN in H0; rewrite HschedN.
      eapply no_running_one_running.
      destruct (unique_runing_not_running _ _ H0) as [HH | HH]; auto.
      destruct HH as [cnt' [c' [KRUN NOT_HALTED]]].
      pose (@gLockSetCode tid0 c).
      replace cnt' with ctn in KRUN.
      + rewrite Hcode in KRUN; inversion KRUN.
      + eapply msl.Axioms.proof_irr.
    - subst.
      destruct (schedPeek a'); auto.
      intros j cntj q j_runs j_not_halted.
      inversion HschedN; subst tid0.
      assert (Htstep':=Htstep).
      apply threadStep_equal_run with (j:=j) in Htstep.
      assert (HH: exists (cntj : containsThread c' j) (q : C),
              getThreadC cntj = Krun q).
      { exists cntj, q; auto. }
      apply Htstep in HH; destruct HH as [cnt [q0 j_runs0]].
      eapply H0; eauto.
      intros HH; apply j_not_halted;
      eapply threadStep_not_unhalts; eauto.
    - destruct (schedPeek a') eqn:SCH'; auto.
      rewrite HschedN in H0.
      inversion Htstep; subst.
      eapply one_running_no_running in H0.
      destruct (unique_runing_not_running _ _ H0) as [HH | HH]; auto.
      destruct HH as [cnt' [c' [KRUN NOT_HALTED]]].
      erewrite gssThreadCC in KRUN. inversion KRUN.
    - subst.
      rewrite HschedN in H0.
      destruct (schedPeek (schedSkip a)) eqn:AAA; auto.
      unfold unique_Krun in H0.
      intros j cntj q j_runs j_not_halted.

      assert (Htstep':=Htstep).
      eapply syncstep_equal_run in Htstep'.
      assert (HH: exists (cntj : containsThread c' j) (q : C),
                 getThreadC cntj = Krun q).
      { exists cntj, q; auto. }
      apply Htstep' in HH; destruct HH as [cnt [q0 j_runs0]].

      destruct (eq_tid_dec tid0 j); subst.
      + exfalso; eapply
                 (syncstep_not_running _ _ _ _ _ _ _ _ _ _ Htstep).
        eapply j_runs0.
      + destruct (Classical_Prop.classic (threadHalted cnt)) as [halt | n_halt].
        * exfalso; apply j_not_halted.
          eapply (syncstep_equal_halted ) in Htstep; eauto.
          eapply Htstep; eassumption.
        * eapply H0 in j_runs0; eauto.
          exfalso; apply n; destruct (eq_tid_dec tid0 j); auto; inversion j_runs0.
    - destruct (schedPeek a') eqn:SCH'; auto.
      rewrite HschedN in H0.
      subst c'.
      destruct (unique_runing_not_running _ _ H0) as [HH | HH]; auto.
      intros j cnti q KRUN NOT_HALT.
      assert (HHH:= NOT_HALT).
      contradict HHH.
      specialize (H0 _ _ _ KRUN NOT_HALT).
      destruct (eq_tid_dec tid0 j); try solve[inversion H0].
      subst tid0.
      replace cnti with Htid; auto.
      eapply msl.Axioms.proof_irr.
    - destruct (schedPeek a') eqn:SCH'; auto.
      rewrite HschedN in H0.
      subst c'.
      intros j cnti q KRUN NOT_HALT.
      assert (HHH:= NOT_HALT).
      contradict HHH.
      specialize (H0 _ _ _ KRUN NOT_HALT).
      destruct (eq_tid_dec tid0 j); try solve[inversion H0].
      subst tid0.
      contradict Htid; assumption.
  Qed.

  Lemma step_valid: forall {ge st m st' m'},
      MachStep ge st m st' m'  ->
      valid st ->
      valid st'.
  Proof. intros ? ? ? ? ?; eapply step_sch_correct. Qed.

  Lemma step_new_valid: forall {ge st m st' m'},
      MachStep ge st m st' m'  ->
      new_valid (mk_nstate st m) (fst (fst st)) ->
      new_valid (mk_nstate st' m') (fst (fst st')).
  Proof. intros ? ? ? ? ? STEP VAL.
         eapply step_sch_correct; eauto.
  Qed.

  Lemma step_correct_schedule: forall {ge U tr tp m tr' tp' m'},
      MachStep ge (U, tr, tp) m (schedSkip U, tr', tp') m' ->
      correct_schedule (U, tr, tp) ->
      forall U'', correct_schedule (U'', tr', tp').
  Proof.
    unfold correct_schedule in *.
    intros ? ? ? ? ? ? ? ? ?.

    inversion H; subst; simpl in *;
    match goal with
    | [ H: schedPeek (schedSkip ?U) = Some _, H': U = schedSkip U  |- _ ] =>
      solve[rewrite <- H' in H; apply end_of_sch in H'; rewrite H' in H; inversion H]
    | _ => idtac
    end.
    - rewrite HschedN; intros.
      destruct (schedPeek U''); auto.
      inversion Htstep; subst.
      intros j cnti q KRUN NOT_HALT.
      unfold unique_Krun in H0.
      destruct (eq_tid_dec tid0 j).
      + subst tid0. rewrite gssThreadCC in KRUN; inversion KRUN.
      + erewrite <- (gsoThreadCC n (cntUpdateC' cnti))  in KRUN; eauto.
        eapply H0 in KRUN.
        destruct (eq_tid_dec tid0 j) as [e|e].
        * rewrite e in n; exfalso; apply n; auto.
        * inversion KRUN.
          intros HALT; eapply NOT_HALT.
          Set Printing Implicit.
          eapply threadHalt_update in HALT; eauto.
    - rewrite HschedN.
      intros. destruct (schedPeek U'') eqn:UUU; trivial.
      intros j cnti q KRUN NOT_HALT.
      assert (HH: exists (cntj : containsThread tp' j) (q : C),
                   getThreadC cntj = Krun q).
        { exists cnti, q; assumption. }
        eapply syncstep_equal_run in HH; eauto.
        destruct HH as [cntj [q0 KRUN']].

        assert (HH:=KRUN').
        eapply H0 in HH.

        assert (HH': ~ @threadHalted j tp cntj).
        { intros HH'. apply NOT_HALT.
          eapply syncstep_equal_halted in Htstep; eauto.
          eapply Htstep.
          exact HH'. }
        apply HH in HH'.

        destruct (eq_tid_dec tid0 j); try solve[ inversion HH'].
        subst.
        eapply syncstep_not_running in Htstep.
        exfalso; apply Htstep.
        eassumption.
    - rewrite HschedN. intros UNIQUE U''.
      destruct (schedPeek U'') eqn:UUU; trivial.
      intros j cnti q KRUN NOT_HALT.
      specialize (UNIQUE _ _ _ KRUN NOT_HALT).
      destruct (eq_tid_dec tid0 j); try solve[inversion UNIQUE]; subst tid0.
      exfalso; apply NOT_HALT.
      replace cnti with Htid by eapply msl.Axioms.proof_irr; auto.
    - rewrite HschedN. intros UNIQUE U''.
      destruct (schedPeek U'') eqn:UUU; trivial.
      intros j cnti q KRUN NOT_HALT.
      specialize (UNIQUE _ _ _ KRUN NOT_HALT).
      destruct (eq_tid_dec tid0 j); try solve[inversion UNIQUE]; subst tid0.
      exfalso; apply Htid.
      eassumption.
  Qed.

  Lemma step_sch_valid: forall {ge U tr tp m tr' tp' m'}, MachStep ge (U, tr, tp) m (schedSkip U, tr', tp') m' -> valid (U, tr, tp) -> forall U'', valid (U'', tr', tp').
  Proof. intros; eapply step_correct_schedule; eauto. Qed.

  Lemma step_sch_new_valid:
    forall {ge U tr tp m tr' tp' m'},
      MachStep ge (U, tr, tp) m (schedSkip U, tr', tp') m' ->
      new_valid (tr, tp, m) U ->
      forall U'', new_valid (tr', tp', m') U''.
  Proof. intros ? ? ? ? ? ? ? ? STEP VAL.
         eapply step_correct_schedule; eauto.

  Qed.

  Lemma safety_equivalence':
    forall ge st_ m,
      (forall U n, new_valid (nil, st_, m) U -> ksafe_new_step ge (U, nil, st_) m n) ->
      (forall U n, new_valid (nil, st_, m) U ->  csafe ge (U, nil, st_) m n).
  Proof.
    move=> ge st_ m KSF' U n VAL.
    assert (KSF: forall U, new_valid (nil, st_, m) U -> ksafe_new_step ge (U, nil, st_) m n) by (move=> U'' NV; apply: KSF'=>// ).
    clear KSF'.
    (* assert (VAL_: new_valid (nil, st_, m) U).
    { rewrite /new_valid /mk_ostate /=.
      split; auto. *)
    (*  by rewrite /new_valid /mk_ostate /= //. clear VAL.*)

    (*move: VAL_=> /(KSF _ n) KSF_new.*)
    move: st_ m KSF U VAL.
    induction n.
    - constructor.
    - move => st_ m KSF U nVAL.
      move: (nVAL) => /KSF => KSF_new.
      inversion KSF_new; subst.
      move: H0; rewrite /new_step /mk_nstate /= => STEP_halt.
      inversion STEP_halt.
      + subst; move: H6; rewrite /mk_ostate=> H6; apply: HaltedSafe=>//.
      + subst; move: H; rewrite /mk_ostate /= => H.
          assert (HH:=step_trace H); rewrite -HH in H.
        destruct (step_sch H).
        * subst U'; apply: (CoreSafe _ _ _ (snd (fst st')) (snd st')) =>/= //.
          { apply: IHn => //.
            - move => U'' nVAL'; rewrite /ksafe_new_step /mk_nstate => /=.
              destruct st' as [p m0]; destruct p=> /=. simpl in HH; rewrite -HH in H1.
              apply: H1=> //.
            - rewrite /new_valid /mk_ostate=> /=.
              apply: (step_new_valid H) =>//.
          }
        * subst U'. apply: (AngelSafe _ _ _ (snd (fst st')) (snd st'))=>//.
          move=>U''.
          { destruct st' as [[tr' tp'] m'] => /=; eapply IHn.
            - move => U0 nVAL0. rewrite /ksafe_new_step /mk_nstate=> /=.
              simpl in HH; rewrite -HH in H1.
              by apply: H1.
            - simpl in H.
              eapply (step_sch_new_valid H); eauto.
          }
  Qed.

  Lemma safety_equivalence:
    forall ge tp m,
      (forall U, new_valid (nil, tp, m) U) ->
      (forall n U, ksafe_new_step ge (U, nil, tp) m n) ->
      (forall n U, csafe ge (U, nil, tp) m n).
  Proof. by move => ? ? ? H ? ? ?; apply: safety_equivalence'; try apply: H. Qed.

  (** *I further create a different type of safety that discriminates non-determinism*)

  Definition explicit_safety ge (U:Sch) (st:machine_state) (m:mem): Prop:=
    exp_safety _ _ (fun U stm => halted (U, nil, fst stm))
                   (fun U stm stm' => @internal_step ge U (fst stm) (snd stm) (fst stm') (snd stm'))
                   (fun U stm U' stm' => @external_step ge U nil (fst stm) (snd stm) U' nil (fst stm') (snd stm'))
                   (fun U stm => @new_valid (nil,fst stm, snd stm) U) U (st,m).

  Definition explicit_safety_bounded ge (U:Sch) (st:machine_state) (m:mem): Prop:=
    exp_safety _ _ (fun U stm => halted (U, nil, fst stm))
                   (fun U stm stm' => @internal_step ge U (fst stm) (snd stm) (fst stm') (snd stm'))
                   (fun U stm U' stm' => @external_step ge U nil (fst stm) (snd stm) U' nil (fst stm') (snd stm'))
                   (fun U stm => @new_valid_bound (nil,fst stm, snd stm) U) U (st,m).

  (*CoInductive explicit_safety ge (U:Sch) (st:machine_state) (m:mem): Prop:=
  | halted_safety : halted (U, nil, st) -> explicit_safety ge U st m
  | internal_safety st' m': @internal_step ge U st m st' m' ->
                            (forall U', new_valid (nil, st', m') U' -> explicit_safety ge U' st' m') ->
                            explicit_safety ge U st m
  | external_safety U' st' m': @external_step ge U nil st m U' nil st' m' ->
                            (forall U', new_valid (nil, st', m') U' -> explicit_safety ge U' st' m') ->
                            explicit_safety ge U st m.*)

  (*BUT, this is basically the same safety!!! *)
  Lemma safety_equivalence21: forall ge st m,
      (forall U, new_valid (nil, st, m) U ->
             safe_new_step ge (U, nil, st) m) ->
      forall U, new_valid (nil, st, m) U ->
            explicit_safety ge U st m.
  Proof.
    move => ge.
    cofix.
    move =>  st m sns_all U /sns_all sns.
    inversion sns.
    move: H; rewrite /mk_nstate /= => stp.
    inversion stp; subst.
    - move: H6; rewrite /mk_ostate /= => hltd.
      eapply (halted_safety); simpl; assumption.
    - destruct st' as [[tr tp] m'].
      move: H H0; rewrite /mk_ostate /MachStep /= => HH.
      move: HH (HH)  => /trace_nil [] ? -> /step_equivalence1 [[] -> [] ? istp | estp] sns_all'.
      + eapply (internal_safety).
        instantiate (1:=(tp,m')); simpl. exact istp.
        eapply safety_equivalence21 => //.
      + eapply (external_safety).
        instantiate (1:=(tp,m')); simpl. exact estp.
        eapply safety_equivalence21 => //.
  Qed.

  Lemma safety_equivalence22: forall ge st m,
      (forall U, new_valid (nil, st, m) U ->
            explicit_safety ge U st m) ->
      (forall U, new_valid (nil, st, m) U ->
             safe_new_step ge (U, nil, st) m).
  Proof.
    move => ge.
    cofix.
    move =>  st m es_all U /es_all es.
    inversion es.
    - econstructor.
      + econstructor. rewrite /mk_nstate /mk_ostate /= //.
      + rewrite /mk_nstate /= => U'' VAL.
        apply: safety_equivalence22 => //.
    - econstructor.
      + econstructor 2.
        instantiate(1:=(@nil machine_event, fst y', snd y')).
        rewrite /mk_nstate /mk_ostate /MachStep /=.
        move: H => / step_equivalence2.
        instantiate(1:=U).
        simpl => //.
      + rewrite /mk_nstate /= => U'' VAL.
        destruct y';
        apply: safety_equivalence22 => //.
    - econstructor.
      + econstructor 2.
        instantiate(1:=(@nil machine_event, fst y' ,  snd y')).
        rewrite /mk_nstate /mk_ostate /MachStep /=.
        move: H => / step_equivalence3.
        instantiate(1:=x').
        simpl => //.
      + rewrite /mk_nstate /= => U'' VAL.
        destruct y';
        apply: safety_equivalence22 => //.
  Qed.
  Lemma safety_equivalence2: forall ge st m,
      (forall U, new_valid (nil, st, m) U ->
             safe_new_step ge (U, nil, st) m) <->
      (forall U, new_valid (nil, st, m) U ->
            explicit_safety ge U st m).
  Proof.
    move => ge st m; split;
           [apply: safety_equivalence21 | apply: safety_equivalence22].
  Qed.

  (** * AND another safety: explicift safety with stutter *)
  Section newer_semantics_with_stutter.
    Context {core_data: Type}
            {core_ord : core_data -> core_data -> Prop}
            (core_ord_wf : well_founded core_ord).

    Definition stutter_stepN_safety ge cd (U:Sch) (st:machine_state) (m:mem): Prop:=
    @exp_safetyN_stutter _ _ (fun U stm => halted (U, nil, fst stm))
                   (fun U stm stm' => @internal_step ge U (fst stm) (snd stm) (fst stm') (snd stm'))
                   (fun U stm U' stm' => @external_step ge U nil (fst stm) (snd stm) U' nil (fst stm') (snd stm'))
                   (fun U stm => @new_valid (nil,fst stm, snd stm) U)
                   core_data core_ord
                   cd U (st,m).

    Variable default: core_data.

    (*This lemma is not needed but it's cool
      How come the standard library doesn't have it!? *)
    Lemma weak_well_founded_induction:
      forall (A : Type) (R : A -> A -> Prop),
      (forall P, P \/ ~P) ->
        well_founded R ->
        forall P : A -> Prop,
          (forall x: A, ~ (exists y:A, R y x) -> P x) ->
          (forall x : A, (exists y : A, R y x /\ P y) -> P x) ->
          forall a : A, P a.
    Proof.
      move => A R EM WF P base ind a.
      specialize (WF a).
      induction WF.
      generalize (EM (exists y: A, R y x)) ; move => [[]y Ryx | is_base ].
      - by apply: ind; exists y; split; auto.
      - by apply: base.
    Qed.

    End newer_semantics_with_stutter.

  End new_safety.

  Lemma csafe_reduce:
    forall ge sched tp mem n m,
      csafe ge (sched, [::], tp) mem n ->
      m <= n ->
      csafe ge (sched, [::], tp) mem m.
  Proof.
    intros. generalize n mem tp sched H0 H.
    induction m.
    intros. constructor.
    intros.
    assert (exists n', n0 = S n').
    { clear - H1. induction H1. exists m; auto.
      destruct IHle. exists (S x); auto. }
    destruct H3 as [n' H3].
    subst.
    inversion H2.
    + constructor 2; auto.
    + econstructor 3; eauto.
      simpl. subst. eapply IHm.
      omega. simpl in Hsafe. instantiate (1:=n').
      Focus 2. simpl in Hsafe. eauto.
      omega.
    + econstructor 4; eauto.
      simpl. subst. intros. eapply IHm.
      omega. simpl in Hsafe. instantiate (1:=n').
      Focus 2. simpl in Hsafe. eauto.
      omega.
  Qed.

End CoarseMachine.

Module FineMachine (SCH:Scheduler)(SIG : ConcurrentMachineSig with Module ThreadPool.TID:=SCH.TID with Module Events.TID:=SCH.TID)<: ConcurrentMachine with Module SCH:= SCH with Module TP:= SIG.ThreadPool with Module SIG:= SIG.
  Module SCH:=SCH.
  Module TP:=SIG.ThreadPool.
  Module SIG:=SIG.
  Import SCH SIG TID ThreadPool ThreadPool.SEM Events.

  Notation Sch:=schedule.
  Notation machine_state := ThreadPool.t.
  Notation event_trace := (seq machine_event).

  Inductive start_thread' genv: forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | StartThread: forall tid0 ms ms' c_new vf arg
                   (ctn: containsThread ms tid0)
                   (Hcode: getThreadC ctn = Kinit vf arg)
                   (Hinitial: initial_core Sem genv vf (arg::nil) = Some c_new)
                   (Hinv: invariant ms)
                   (Hms': updThreadC ctn (Krun c_new)  = ms'),
      start_thread' genv ctn ms'.
  Definition start_thread genv: forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @start_thread' genv.

  Inductive resume_thread': forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | ResumeThread: forall tid0 ms ms' c c' X
                    (ctn: containsThread ms tid0)
                    (Hat_external: at_external Sem c = Some X)
                    (Hafter_external:
                       after_external Sem None c = Some c')
                    (Hcode: getThreadC ctn = Kresume c Vundef)
                    (Hinv: invariant ms)
                    (Hms': updThreadC ctn (Krun c')  = ms'),
      resume_thread' ctn ms'.
  Definition resume_thread: forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @resume_thread'.

  Inductive suspend_thread': forall {tid0} {ms:machine_state},
      containsThread ms tid0 -> machine_state -> Prop:=
  | SuspendThread: forall tid0 ms ms' c X
                     (ctn: containsThread ms tid0)
                     (Hcode: getThreadC ctn = Krun c)
                     (Hat_external: at_external Sem c = Some X)
                     (Hinv: invariant ms)
                     (Hms': updThreadC ctn (Kblocked c) = ms'),
      suspend_thread' ctn ms'.
  Definition suspend_thread : forall {tid0 ms},
      containsThread ms tid0 -> machine_state -> Prop:=
    @suspend_thread'.

  Inductive machine_step {genv:G}:
    Sch -> event_trace -> machine_state -> mem -> Sch
    -> event_trace -> machine_state -> mem -> Prop :=
  | start_step:
      forall tid U U' ms ms' m tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: start_thread genv Htid ms'),
        machine_step U tr ms m U' tr ms' m
  | resume_step:
      forall tid U U' ms ms' m tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: resume_thread Htid ms'),
        machine_step U tr ms m U' tr ms' m
  | thread_step:
      forall tid U U' ms ms' m m' ev tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: threadStep genv Htid Hcmpt ms' m' ev),
        machine_step U tr ms m U'
                     (tr ++ (List.map (fun mev => internal tid mev) ev))
                     ms' (diluteMem m')
  | suspend_step:
      forall tid U U' ms ms' m tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: suspend_thread Htid ms'),
        machine_step U tr ms m U' tr ms' m
  | sync_step:
      forall tid U U' ms ms' m m' tr ev
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Htstep: syncStep false genv Htid Hcmpt ms' m' ev),
        machine_step U tr ms m U' (tr ++ [:: external tid ev]) ms' m'
  | halted_step:
      forall tid U U' ms m tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Htid: containsThread ms tid)
        (Hcmpt: mem_compatible ms m)
        (Hinv: invariant ms)
        (Hhalted: threadHalted Htid),
        machine_step U tr ms m U' tr ms m
  | schedfail :
      forall tid U U' ms m tr
        (HschedN: schedPeek U = Some tid)
        (HschedS: schedSkip U = U')        (*Schedule Forward*)
        (Hcmpt: mem_compatible ms m)
        (Hinv: invariant ms)
        (Htid: ~ containsThread ms tid),
        machine_step U tr ms m U' tr ms m.

  Definition MachState: Type := (Sch * event_trace * machine_state)%type.

  Definition MachStep G (c:MachState) (m:mem)
             (c' :MachState) (m':mem) :=
    @machine_step G (fst (fst c)) (snd (fst c)) (snd c)  m
                  (fst (fst c')) (snd (fst c')) (snd c')  m'.

  Definition at_external (st : MachState)
    : option (external_function * list val) := None.

  Definition after_external (ov : option val) (st : MachState) :
    option (MachState) := None.

  Definition halted (st : MachState) : option val :=
    match schedPeek (fst (fst st)) with
    | Some _ => None
    | _ => Some Vundef
    end.

  Definition init_machine (U:schedule) (p : option RES.res) the_ge
             (f : val) (args : list val) : option MachState :=
    match init_mach p the_ge f args with
    | None => None
    | Some c => Some (U, [::],c)
    end.

  Program Definition MachineSemantics (U:schedule) (p : option RES.res):
    CoreSemantics G MachState mem.
  intros.
  apply (@Build_CoreSemantics _ MachState _
                              (init_machine U p)
                              at_external
                              after_external
                              halted
                              MachStep
        );
    unfold at_external, halted; try reflexivity.
  intros. inversion H; subst; rewrite HschedN; reflexivity.
  auto.
  Defined.

  Lemma initial_schedule: forall genv main vals U U' p c tr,
      initial_core (MachineSemantics U p) genv main vals = Some (U',tr,c) ->
      U' = U /\ tr = nil.
        simpl. unfold init_machine. intros.
        destruct (init_mach p genv main vals); try solve[inversion H].
        inversion H; subst; split; auto.
  Qed.

  (** Schedule safety of the fine-grained machine*)
   Inductive fsafe (ge : SEM.G) (tp : thread_pool) (m : mem) (U : Sch)
    : nat -> Prop :=
  | Safe_0: fsafe ge tp m U 0
  | HaltedSafe : forall n tr, halted (U, tr, tp) -> fsafe ge tp m U n
  | StepSafe : forall (tp' : thread_pool) (m' : mem)
                 (tr tr': event_trace) n,
      MachStep ge (U, tr, tp) m (schedSkip U, tr', tp') m' ->
      fsafe ge tp' m' (schedSkip U) n ->
      fsafe ge tp m U (S n).

End FineMachine.

Module Events <: EventSig
   with Module TID:=NatTID.

 Module TID := NatTID.
 Import TID event_semantics.

 (** Synchronization Events.  The release/acquire cases include the
footprints of permissions moved  when applicable*)
 Definition evRes := (access_map * access_map)%type.
 Definition evDelta := (delta_map * delta_map)%type.

 Inductive sync_event : Type :=
 | release : address (*-> option (evRes * evDelta)*) -> option evRes -> sync_event
 | acquire : address -> option evDelta (*option (evRes * evDelta) -> option evRes*)  -> sync_event
 | mklock :  address -> sync_event
 | freelock : address -> sync_event
 | spawn : address -> option (evRes * evDelta) -> option evDelta -> sync_event
 | failacq: address -> sync_event.

 (** Machine Events *)
  Inductive machine_event : Type :=
  | internal: TID.tid -> mem_event -> machine_event
  | external : TID.tid -> sync_event -> machine_event.

  Definition thread_id ev : tid :=
    match ev with
    | internal i _ => i
    | external i _ => i
    end.

  Inductive act : Type :=
  | Read : act
  | Write : act
  | Alloc : act
  | Free : act
  | Release : act
  | Acquire : act
  | Mklock : act
  | Freelock : act
  | Failacq : act
  | Spawn : act.

  Definition is_internal ev :=
    match ev with
    | internal _ _ => true
    | _ => false
    end.

  Definition is_external ev :=
    match ev with
    | external _ _ => true
    | _ => false
    end.

  Definition action ev : act :=
    match ev with
    | internal _ mev =>
      match mev with
      | event_semantics.Write _ _ _ => Write
      | event_semantics.Read _ _ _ _ => Read
      | event_semantics.Alloc _ _ _ => Alloc
      | event_semantics.Free _ => Free
      end
    | external _ sev =>
      match sev with
      | release _ _ => Release
      | acquire _ _ => Acquire
      | mklock _ => Mklock
      | freelock _ => Freelock
      | failacq _ => Failacq
      | spawn _ _ _ => Spawn
      end
    end.

  Definition location ev : option (address*nat) :=
    match ev with
    | internal _ mev =>
      match mev with
      | event_semantics.Write b ofs vs => Some ((b, ofs), length vs)
      | event_semantics.Read b ofs _ vs => Some ((b, ofs), length vs)
      | _ => None
      end
    | external _ sev =>
      match sev with
      | release addr _ => Some (addr, lksize.LKSIZE_nat)
      | acquire addr _ => Some (addr, lksize.LKSIZE_nat)
      | mklock addr => Some (addr, lksize.LKSIZE_nat)
      | freelock addr => Some (addr, lksize.LKSIZE_nat)
      | spawn addr _ _ => Some (addr, lksize.LKSIZE_nat)
      | failacq addr => Some (addr, lksize.LKSIZE_nat)
      end
    end.

End Events.


Require Import Eqdep Lia Framework FSParameters CachedDiskLayer.
Require Import BatchOperations Log LogCache.
Require Import ATCDLayer.
Require Import ATCD_TS_BatchOperations_Recovery ATCD_TS_Log_Recovery.

Set Nested Proofs Allowed.

Lemma combine_same_to_map:
  forall T (l: list T),
  combine l l = map (fun t => (t, t)) l.
  Proof.
    induction l; simpl; eauto.
    rewrite IHl; eauto.
  Qed.

Lemma LogCache_TS_write_batch_to_cache:
forall u l1 l2 l3 l4 s1 s2 o s1' t,
exec CachedDiskLang u o s1
(LogCache.write_batch_to_cache l1 l3)
     (Finished s1' t) ->
  length l1 = length l2 ->
  length l3 = length l4 ->
exists s2' t,
exec CachedDiskLang u o s2
(LogCache.write_batch_to_cache l2 l4)
     (Finished s2' t).
Proof.
induction l1; destruct l2; simpl in *;
try lia; intros; repeat invert_exec.
{
  intros; do 2 eexists; repeat econstructor.
}
{
  cleanup; destruct l4; simpl in *; try lia;
  repeat invert_exec;
  try solve [do 2 eexists; repeat econstructor].
  edestruct IHl1.
  eauto.
  3: cleanup; do 2 eexists; repeat econstructor; eauto.
  all: eauto.
}
Qed.

Lemma LogCache_TS_write_lists_to_cache:
forall u l1 l2 s1 s2 o s1' t,
exec CachedDiskLang u o s1
(LogCache.write_lists_to_cache l1)
     (Finished s1' t) ->
  length l1 = length l2 ->
  Forall2 (fun lx ly => length (fst lx) = length (fst ly) /\
  length (snd lx) = length (snd ly)) l1 l2 ->
exists s2' t,
exec CachedDiskLang u o s2
(LogCache.write_lists_to_cache l2)
     (Finished s2' t).
Proof.
induction l1; destruct l2; simpl in *;
try lia; intros; repeat invert_exec.
{
  intros; do 2 eexists; repeat econstructor.
}
{
  inversion H1; cleanup.
  eapply LogCache_TS_write_batch_to_cache with (l2:=fst p) (l4:= snd p)in H; cleanup.
  edestruct IHl1.
  eauto.
  3:cleanup; do 2 eexists; repeat econstructor; eauto.
  all: eauto.
}
Qed.

Lemma LogCache_TS_write_batch_to_cache_crashed:
forall u l1 l2 l3 l4 s1 s2 o s1',
exec CachedDiskLang u o s1
(LogCache.write_batch_to_cache l1 l3)
     (Crashed s1') ->
  length l1 = length l2 ->
  length l3 = length l4 ->
exists s2',
exec CachedDiskLang u o s2
(LogCache.write_batch_to_cache l2 l4)
     (Crashed s2').
Proof.
induction l1; destruct l2; simpl in *;
try lia; intros; repeat invert_exec.
{
  intros; eexists; repeat econstructor.
}
{
  cleanup; destruct l4; simpl in *; try lia;
  repeat invert_exec;
  try solve [eexists; repeat econstructor].

  split_ors; cleanup; repeat invert_exec.
  {
    eexists; repeat econstructor; eauto.
  }
  edestruct IHl1.
  eauto.
  3: cleanup; eexists; repeat econstructor; eauto.
  all: eauto.
}
Qed.

Lemma LogCache_TS_write_lists_to_cache_crashed:
forall u l1 l2 s1 s2 o s1',
exec CachedDiskLang u o s1
(LogCache.write_lists_to_cache l1)
     (Crashed s1') ->
  length l1 = length l2 ->
  Forall2 (fun lx ly => length (fst lx) = length (fst ly) /\
  length (snd lx) = length (snd ly)) l1 l2 ->
exists s2',
exec CachedDiskLang u o s2
(LogCache.write_lists_to_cache l2)
     (Crashed s2').
Proof.
induction l1; destruct l2; simpl in *;
try lia; intros; repeat invert_exec.
{
  intros; eexists; repeat econstructor.
}
{
  inversion H1; cleanup.
  split_ors; cleanup; repeat invert_exec.
  {
    eapply LogCache_TS_write_batch_to_cache_crashed with (l2:=fst p) (l4:= snd p)in H; cleanup.
    eexists; repeat econstructor; eauto.
    all: eauto.
  }
  eapply LogCache_TS_write_batch_to_cache with (l2:=fst p) (l4:= snd p)in H2; cleanup.
  edestruct IHl1.
  eauto.
  3:cleanup; eexists; repeat econstructor; eauto.
  all: eauto.
}
Qed.

Lemma LogCache_TS_recover:
forall u s1 s2 o s1' t txns1 txns2 sa1 sa2 hdr1 hdr2 valid_part,
exec CachedDiskLang u o s1 LogCache.recover
     (Finished s1' t) ->

((exists (hdr_blockset: set value) (log_blocksets: list (set value)),
Log.log_rep_explicit Log.Hdr_Synced Log.Synced valid_part hdr1
txns1 hdr_blockset log_blocksets (snd s1) /\
(valid_part = Log.Old_Part ->
 Log.hash (Log.current_part hdr1) <>
 rolling_hash hash0 (firstn (Log.count (Log.current_part hdr1))
 (map fst log_blocksets)))) /\
sa1 = total_mem_map fst (shift (plus data_start)
(list_upd_batch_set (snd (snd s1)) (map Log.addr_list txns1) (map Log.data_blocks txns1))) /\
(forall a, a >= data_start -> snd ((snd (snd s1)) a) = []) /\
(forall a vs, snd (snd s1) a = vs -> snd vs = nil)) ->

((exists (hdr_blockset: set value) (log_blocksets: list (set value)),
Log.log_rep_explicit Log.Hdr_Synced Log.Synced valid_part hdr2
txns2 hdr_blockset log_blocksets (snd s2) /\
(valid_part = Log.Old_Part ->
 Log.hash (Log.current_part hdr2) <>
 rolling_hash hash0 (firstn (Log.count (Log.current_part hdr2))
 (map fst log_blocksets)))) /\
sa2 = total_mem_map fst (shift (plus data_start)
(list_upd_batch_set (snd (snd s2)) (map Log.addr_list txns2) (map Log.data_blocks txns2))) /\
(forall a, a >= data_start -> snd ((snd (snd s2)) a) = []) /\
(forall a vs, snd (snd s2) a = vs -> snd vs = nil)) ->

length txns1 = length txns2 ->

(Log.count (Log.current_part hdr1) = Log.count (Log.current_part hdr2)) ->

Forall2
(fun rec1 rec2 : Log.txn_record =>
 Log.start rec1 = Log.start rec2 /\
 Log.addr_count rec1 = Log.addr_count rec2 /\
 Log.data_count rec1 = Log.data_count rec2)
(map Log.record txns1)
(map Log.record txns2) ->

exists s2' t,
exec CachedDiskLang u o s2 LogCache.recover
     (Finished s2' t).
Proof.
Transparent LogCache.recover.
Opaque Log.recover.
unfold LogCache.recover in *.
simpl in *; intros;
cleanup; repeat invert_exec.

unfold Log.log_reboot_rep in *.
simpl in *; intros;
cleanup; repeat invert_exec.

eapply_fresh Log_TS_recover in H13; eauto; cleanup.
eapply_fresh Specs.recover_finished in H; eauto.
eapply_fresh Specs.recover_finished in H13; eauto.
all: try solve[unfold Log.log_reboot_rep;
rewrite <- H3 in *; eauto;
do 4 eexists; intuition eauto].
2:{
  unfold Log.log_reboot_rep;
do 4 eexists; intuition eauto.
}
eapply LogCache_TS_write_lists_to_cache in H5; cleanup.

do 2 eexists; repeat econstructor; eauto.
rewrite cons_app; repeat econstructor; eauto.
eapply lift2_exec_step; eauto.

do 2 rewrite combine_length; do 4 rewrite map_length; eauto.
apply forall_forall2.
apply Forall_forall; intros.
repeat rewrite <- combine_map' in H14.
apply in_map_iff in H14; cleanup; simpl.

repeat rewrite combine_same_to_map in H15.
rewrite <- combine_map' in H15.
apply in_map_iff in H15; cleanup; simpl.
apply forall2_forall in H4.
eapply Forall_forall in H4; eauto.
2: rewrite <- combine_map'; eapply in_map_iff; eauto.
2:repeat rewrite combine_length_eq; repeat rewrite map_length; eauto.
simpl in *.

unfold Log.log_rep_explicit, Log.log_rep_inner,
Log.txns_valid in *; logic_clean.
destruct x7;
eapply_fresh in_combine_l in H15;
eapply_fresh in_combine_r in H15;
simpl in *.

eapply Forall_forall in H24; eauto.
eapply Forall_forall in H32; eauto.
unfold Log.txn_well_formed, Log.record_is_valid in *; logic_clean.
rewrite H35, H46.
split; try lia.
repeat rewrite firstn_length_l; try lia.

Unshelve.
exact CachedDiskLang.
Qed.

Lemma LogCache_TS_recover_crashed:
forall u s1 s2 o s1' txns1 txns2 sa1 sa2 hdr1 hdr2 valid_part,
exec CachedDiskLang u o s1 LogCache.recover (Crashed s1') ->

((exists (hdr_blockset: set value) (log_blocksets: list (set value)),
Log.log_rep_explicit Log.Hdr_Synced Log.Synced valid_part hdr1
txns1 hdr_blockset log_blocksets (snd s1) /\
(valid_part = Log.Old_Part ->
Log.hash (Log.current_part hdr1) <>
rolling_hash hash0 (firstn (Log.count (Log.current_part hdr1))
(map fst log_blocksets)))) /\
sa1 = total_mem_map fst (shift (plus data_start)
(list_upd_batch_set (snd (snd s1)) (map Log.addr_list txns1) (map Log.data_blocks txns1))) /\
(forall a, a >= data_start -> snd ((snd (snd s1)) a) = []) /\
(forall a vs, snd (snd s1) a = vs -> snd vs = nil)) ->

((exists (hdr_blockset: set value) (log_blocksets: list (set value)),
Log.log_rep_explicit Log.Hdr_Synced Log.Synced valid_part hdr2
txns2 hdr_blockset log_blocksets (snd s2) /\
(valid_part = Log.Old_Part ->
Log.hash (Log.current_part hdr2) <>
rolling_hash hash0 (firstn (Log.count (Log.current_part hdr2))
(map fst log_blocksets)))) /\
sa2 = total_mem_map fst (shift (plus data_start)
(list_upd_batch_set (snd (snd s2)) (map Log.addr_list txns2) (map Log.data_blocks txns2))) /\
(forall a, a >= data_start -> snd ((snd (snd s2)) a) = []) /\
(forall a vs, snd (snd s2) a = vs -> snd vs = nil)) ->

length txns1 = length txns2 ->

(Log.count (Log.current_part hdr1) = Log.count (Log.current_part hdr2)) ->

Forall2
(fun rec1 rec2 : Log.txn_record =>
Log.start rec1 = Log.start rec2 /\
Log.addr_count rec1 = Log.addr_count rec2 /\
Log.data_count rec1 = Log.data_count rec2)
(map Log.record txns1)
(map Log.record txns2) ->

exists s2',
exec CachedDiskLang u o s2 LogCache.recover (Crashed s2').
Proof.
Transparent LogCache.recover.
Opaque Log.recover.
unfold LogCache.recover in *.
simpl in *; intros;
cleanup; repeat invert_exec.
split_ors; cleanup; repeat invert_exec.
eexists; repeat econstructor.

unfold Log.log_reboot_rep in *.
simpl in *; intros;
cleanup; repeat invert_exec.

split_ors; cleanup; repeat invert_exec.
{
eapply_fresh Log_TS_recover_crashed in H9; eauto; cleanup.
rewrite cons_app.
eexists; econstructor; eauto.
repeat econstructor.
econstructor.
eapply lift2_exec_step_crashed; eauto.
rewrite <- H3 in *; eauto.
}
{
eapply_fresh Log_TS_recover in H13; eauto; cleanup.
eapply_fresh Specs.recover_finished in H14; eauto.
eapply_fresh Specs.recover_finished in H13; eauto.
all: try solve[unfold Log.log_reboot_rep;
rewrite <- H3 in *; eauto;
do 4 eexists; intuition eauto].
2:{
  unfold Log.log_reboot_rep;
do 4 eexists; intuition eauto.
}

eapply LogCache_TS_write_lists_to_cache_crashed in H9; cleanup.
rewrite cons_app.
eexists; repeat econstructor; eauto.
eapply lift2_exec_step; eauto.

repeat rewrite combine_length_eq; repeat rewrite map_length; eauto.
apply forall_forall2.
apply Forall_forall; intros.
repeat rewrite <- combine_map' in H.
apply in_map_iff in H; cleanup; simpl.

repeat rewrite combine_same_to_map in H15.
rewrite <- combine_map' in H15.
apply in_map_iff in H15; cleanup; simpl.
apply forall2_forall in H4.
eapply Forall_forall in H4; eauto.
2: rewrite <- combine_map'; eapply in_map_iff; eauto.
2:repeat rewrite combine_length_eq; repeat rewrite map_length; eauto.
simpl in *.

unfold Log.log_rep_explicit, Log.log_rep_inner,
Log.txns_valid in *; logic_clean.
destruct x4;
eapply_fresh in_combine_l in H15;
eapply_fresh in_combine_r in H15;
simpl in *.

eapply Forall_forall in H24; eauto.
eapply Forall_forall in H32; eauto.
unfold Log.txn_well_formed, Log.record_is_valid in *; logic_clean.
rewrite H35, H46.
split; try lia.
repeat rewrite firstn_length_l; try lia.
}
Unshelve.
all: exact CachedDiskLang.
Qed.


(* En este archivo se demuestra la corrección de la acción receiveIntent *)
Require Export Exec.
Require Export Implementacion.
Require Export AuxFunsCorrect.
Require Export ListAuxFuns.
Require Import Classical.
Require Import Estado.
Require Import DefBasicas.
Require Import Semantica.
Require Import Operaciones.
Require Import ErrorManagement.
Require Import Maps.
Require Import Tacticas.
Require Import ValidStateLemmas.
Require Export Coq.Arith.PeanoNat.
Import PeanoNat.Nat.

Section ReceiveIntent.

Lemma receiveIntentCorrect : forall (s:System) (i:Intent) (ic:iCmp) (a:idApp) (sValid: validstate s),
    (pre (receiveIntent i ic a) s) -> post_receiveIntent i ic a s (receiveIntent_post i ic a s).
Proof.
    intros.
    unfold post_receiveIntent.
    simpl in H.
    unfold pre_receiveIntent in H;simpl in H.
    destruct H as [run H].
    destruct H.
    destruct_conj H.
    assert (maybeIntentForAppCmp i a ic s = Some x) as maybeintent.
    apply inttForAppMaybeIntt;auto.
    remember (iCmpGenerator (map_getKeys (running (state s)))) as theIC.
    destruct H2.
    destruct_conj H1.
    split.
  - exists theIC.
    exists x.
    split;auto.
    split;auto.
    assert (~In theIC (map_getKeys (running (state s)))).
    rewrite HeqtheIC.
    apply generatorWorksWell.
    split.
    unfold insNotInState;intros.
    unfold not;intros.
    case_eq (map_apply iCmp_eq (running (state s)) theIC);intros.
    apply H5.
    rewrite valueIffExists in H8.
    unfold map_getKeys.
    rewrite in_map_iff.
    exists {| item_index := theIC; item_info := c |}.
    split;auto.
    apply (runningCorrect);auto.
    rewrite H8 in H7.
    unfold is_Value in H7.
    apply H7.
    split.
    unfold receiveIntent_post.
    unfold runCmp.
    rewrite maybeintent.
    split;intros.
    simpl.
    unfold performRunCmp.
    assert (theIC <> ic').
    unfold not;intros.
    apply H5.
    unfold map_getKeys.
    rewrite in_map_iff.
    rewrite valueIffExists in H7.
    exists {| item_index := ic'; item_info := c' |}.
    simpl.
    auto.
    apply (runningCorrect);auto.

    rewrite<- H7.
    simpl.
    apply overrideNotEq.
    rewrite<- HeqtheIC.
    auto.
    split;intros.
    simpl in H7.
    rewrite<- HeqtheIC in H7.
    unfold performRunCmp in H7.
    elim (classic (theIC = ic'));intros.
    right.
    split;auto.
    rewrite H8 in H7.
    symmetry in H7.
    rewrite <-addAndApply in H7.
    inversion H7.
    auto.
    left.
    rewrite overrideNotEq in H7.
    auto.
    auto.

    simpl.
    unfold performRunCmp.
    rewrite<- HeqtheIC.
    split.
    symmetry.
    apply addAndApply.

    apply addPreservesCorrectness.
    apply runningCorrect;auto.

    case_eq (intType i);intros.
    split;intros.
    specialize (H4 H7).
    case_eq (path (data i));intros.
    left.
    exists u.
    specialize (H4 u H9).
    destruct H4.
    remember (getAnyCProviderWithUri u s) as theCP.

    exists theCP.
    destruct H4.
    split;auto.
    split;auto.
    unfold getAnyCProviderWithUri in HeqtheCP.
    remember (fun cp : CProvider => existsResBool cp u s) as theFun.
    assert (In theCP (getSomes Cmp CProvider (fun cmp : Cmp => match cmp with | cmpAct _ => None | cmpSrv _ => None | cmpCP cp => Some cp | cmpBR _ => None end) (getAllComponents s)) /\ theFun theCP =true).
    rewrite HeqtheCP.
    apply ifExistsFilter.
    exists x1.
    rewrite filter_In.
    split.
    apply inGetSomes.
    exists (cmpCP x1).
    split;auto.
    destruct H4.
    destruct H4.
    apply getAllComponentsIffInApp;auto.
    exists x2.
    auto.
    rewrite HeqtheFun.
    apply existsRes_iff;auto.
    destruct H11.
    rewrite HeqtheFun in H12.
    apply existsRes_iff;auto.

    unfold grantTempPerm.
    unfold receiveIntent_post.
    rewrite maybeintent.
    rewrite H7.
    rewrite H9.
    simpl.
    unfold performGrantTempPerm.
    rewrite<-HeqtheIC.
    split;intros.
    split;intros.

    assert (theIC <> ic').
    unfold not;intros.
    assert (exists c, map_apply iCmp_eq (running (state s)) ic' = Value iCmp c).
    apply (ifDelTPermsThenRunning s sValid ic' cp' u' pt');auto.
    destruct H13.
    apply H5.
    unfold map_getKeys.
    rewrite in_map_iff.
    exists {| item_index := ic'; item_info := x2 |}.
    simpl.
    split;auto.
    rewrite<- valueIffExists.
    exact H13.
    apply (runningCorrect);auto.

    rewrite overrideNotEq.
    auto.
    unfold not;intros.
    apply H12.
    inversion H13.
    auto.

    split;intros.

    elim (classic (theIC = ic' /\ theCP = cp' /\ u = u'));intros.
    right.
    destruct_conj H12.
    rewrite H13 in H11.
    rewrite <-H12 in H11.
    rewrite HeqtheCP in H11.
    rewrite H15 in H11.
    rewrite <-addAndApply in H11.
    inversion H11.
    auto.
    left.
    rewrite overrideNotEq in H11.
    auto.
    unfold not;intros.
    apply H12.
    rewrite HeqtheCP.
    inversion H13.
    auto.
    rewrite HeqtheCP.
    rewrite<- addAndApply.
    auto.
    apply addPreservesCorrectness.
    apply delTPermsCorrect;auto.

    right.
    split;auto.

    unfold receiveIntent_post.
    rewrite maybeintent.
    rewrite H9.
    simpl.
    rewrite H7.
    auto.
    split;intros;discriminate H8.
    split;intros.
    discriminate H8.
    split;intros.

    unfold receiveIntent_post.
    rewrite maybeintent.
    simpl.
    rewrite H7.
    auto.
    discriminate H8.
    split;intros.
    discriminate H8.
    split;intros.
    discriminate H8.

    unfold receiveIntent_post.
    rewrite maybeintent.
    simpl.
    rewrite H7.
    auto.

  - split.
    unfold removeIntent.
    unfold receiveIntent_post.
    rewrite maybeintent.
    simpl.
    split;intros.
    rewrite <-removeSthElse in H5.
    destruct H5.
    auto.
    split;intros.
    elim (classic ((ic',i') = (ic,i)));intros.
    right.
    inversion H7;auto.
    left.
    apply removeSthElse.
    auto.
    rewrite<- removeSthElse.
    unfold not;intros.
    destruct H5.
    apply H5;auto.

    unfold receiveIntent_post.
    rewrite maybeintent.
    simpl.
    repeat (split;auto).
Qed.

Lemma notPreReceiveIntentThenError : forall (s:System) (i:Intent) (ic:iCmp) (a:idApp), ~(pre (receiveIntent i ic a) s) -> validstate s -> exists ec : ErrorCode, response (step s (receiveIntent i ic a)) = error ec /\ ErrorMsg s (receiveIntent i ic a) ec /\ s = system (step s (receiveIntent i ic a)).
Proof.
    intros.
    simpl.
    simpl in H.
    unfold pre_receiveIntent in H.
    unfold receiveIntent_safe.
    unfold receiveIntent_pre.
    case_eq (maybeIntentForAppCmp i a ic s);intros.
    case_eq (isCProviderBool c);intros.
    exists cmp_is_CProvider.
    split;auto.
    split;auto.
    exists c.
    apply inttForAppMaybeInttBack in H1;auto.
    apply isCProviderBool_iff in H2.
    split;auto.

    case_eq (negb (canRunBool a s)); intros.
    exists should_verify_permissions.
    split; auto.
    clear H.
    split.
    rewrite negb_true_iff in H3.
    unfold canRunBool in H3.
    unfold not. intros. unfold canRun in H.
    destruct H.
    case_eq (InBool idApp idApp_eq a (alreadyVerified (state s))); intros.
    rewrite H4 in H3. simpl in H3. inversion H3.
    apply notInBoolNotIn in H4. contradiction.

    destruct H as [m [n [H4 [H5 H6]]]].
    unfold getManifestForApp in H3.
    unfold RuntimePermissions.isManifestOfApp in H4.
    destruct H4.
    rewrite H, H5 in H3.
    case_eq (InBool idApp idApp_eq a (alreadyVerified (state s))); intros.
    rewrite H4 in H3. inversion H3.
    rewrite H4 in H3. simpl in H3.

    assert (vulnerableSdk < n). auto.
    rewrite <- ltb_lt in H7. rewrite H3 in H7.
    inversion H7.

    case_eq (InBool idApp idApp_eq a (alreadyVerified (state s))); intros.
    rewrite H4 in H3. inversion H3.
    rewrite H4 in H3. simpl in H3. clear H4.
    destruct H as [sysapp [H7 [H8 H9]]].
    case_eq (map_apply idApp_eq (manifest (environment s)) a); intros.

    assert (exists m: Manifest,
      map_apply idApp_eq (manifest (environment s)) a = Value idApp m).
    exists m0; auto.

    assert (In sysapp (systemImage (environment s)) /\ idSI sysapp = a).
    auto.

    apply (ifSysImgNoManifestInEnv s H0) in H10.
    contradiction.

    rewrite H in H3. clear H.
    destructVS H0.
    unfold notDupSysApp in notDupSysAppVS.

    induction (systemImage (environment s)).
    inversion H7.

    simpl in H3.
    destruct (idApp_eq a (idSI a0)).
    simpl in H3.

    assert (In a0 (a0::l)). simpl. left. auto.
    rewrite e in H8.

    assert (In sysapp (a0::l) /\
      In a0 (a0::l) /\ idSI sysapp = idSI a0).
    auto.
    apply notDupSysAppVS in H0.
    rewrite <- H0 in H3. rewrite H9 in H3.
    rewrite H5 in H3.
    assert (vulnerableSdk < n). auto.
    rewrite <- ltb_lt in H4. rewrite H3 in H4.
    inversion H4.

    simpl in H7.
    destruct H7. symmetry in H8.
    rewrite H in n0. contradiction.
    apply IHl. intros.
    destruct H0. destruct H4.
    assert (In s1 (a0 :: l)). simpl. right. auto.
    assert (In s2 (a0 :: l)). simpl. right. auto.
    apply notDupSysAppVS. auto.

    auto. auto.

    simpl. auto.

    case_eq (map_apply iCmp_eq (running (state s)) ic);intros.
    case_eq (isCProviderBool c0);intros.
    exists cmp_is_CProvider.
    split;auto.
    split;auto.
    exists c0.
    apply isCProviderBool_iff in H5.
    split;auto.

    case_eq (negb (canStartBool c0 c s));intros.
    exists a_cant_start_b.
    split;auto.
    split;auto.
    exists c,c0.
    apply inttForAppMaybeInttBack in H1;auto.
    split;auto.
    split;auto.
    rewrite negb_true_iff in H6.
    invertBool H6.
    intro.
    apply H6.
    apply canStartCorrect;auto.

    destruct (intType i).
    destruct (path (data i)).
    case_eq (existsb (receiveIntentCmpRequirements c0 u s (intentActionType i)) (getAllComponents s));intros.
    destruct H.
    split.
  - rewrite negb_false_iff in H3.
    apply canRunBool_canRun. auto.
  - exists c.

    split.
    apply inttForAppMaybeInttBack in H1;auto.

    split.
    invertBool H2.
    intro.
    apply H2.
    apply isCProviderBool_iff;auto.

    exists c0.
    split;auto.

    split.
    invertBool H5.
    intro.
    apply H5.
    apply isCProviderBool_iff;auto.

    split.
    rewrite negb_false_iff in H6.
    apply canStartCorrect;auto.
    split;intros.

    rewrite existsb_exists in H7.
    destruct H7.
    destruct H7.
    unfold receiveIntentCmpRequirements in H9.
    destruct x;try discriminate H9.
    exists c1.
    rewrite andb_true_iff in H9.
    destruct H9.
    rewrite andb_true_iff in H9.
    destruct H9.
    inversion H8.
    rewrite <- H13 in *.
    split.
    apply existsRes_iff;auto.
    split.
    apply canGrantCorrect;auto.
    unfold canRead.
    unfold canWrite.
    unfold canReadBool in H10.
    unfold canWriteBool in H10.
    destruct (intentActionType i); try rewrite orb_true_iff in H10.
    destruct H10.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    destruct H10.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.

    rewrite andb_true_iff in H10.
    destruct H10.
    split.
    rewrite orb_true_iff in H10.
    destruct H10.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    rewrite orb_true_iff in H12.
    destruct H12.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    destruct H.
    discriminate H.

  - exists no_CProvider_fits.
    split;auto.
    split;auto.
    exists c0.
    split;auto.
    split;auto.
    intros.
    inversion H8.
    rewrite <-H10 in *.
    invertBool H7.
    intro.
    apply H7.
    destruct H9.
    destruct_conj H9.
    rewrite existsb_exists.
    exists (cmpCP x).
    split.
    unfold existsRes in H11.
    destruct H11.
    destruct H11.
    apply getAllComponentsIffInApp;auto.
    exists x0;auto.
    unfold receiveIntentCmpRequirements.
    rewrite andb_true_iff.
    split.
    rewrite andb_true_iff.
    split.
    apply existsRes_iff;auto.
    apply canGrantCorrect;auto.
    unfold canRead in H13.
    unfold canWrite in H13.
    unfold canReadBool.
    unfold canWriteBool.
    destruct (intentActionType i).
    rewrite orb_true_iff.
    destruct H13.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    rewrite orb_true_iff.
    destruct H13.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    rewrite andb_true_iff.
    destruct H13.
    split;rewrite orb_true_iff.
    destruct H12.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.
    destruct H13.
    left.
    apply canDoThisBoolCorrect;auto.
    right.
    apply delPermsBoolCorrect;auto.

  - destruct H.
    split.
 -- rewrite negb_false_iff in H3.
    apply canRunBool_canRun. auto.
 -- exists c.

    split.
    apply inttForAppMaybeInttBack in H1;auto.

    split.
    invertBool H2.
    intro.
    apply H2.
    apply isCProviderBool_iff;auto.

    exists c0.
    split;auto.

    split.
    invertBool H5.
    intro.
    apply H5.
    apply isCProviderBool_iff;auto.

    split.
    rewrite negb_false_iff in H6.
    apply canStartCorrect;auto.
    split;intros.
    discriminate H7.
    destruct H.
    discriminate H.

  - destruct H.
    split.
 -- rewrite negb_false_iff in H3.
    apply canRunBool_canRun. auto.
 -- exists c.

    split.
    apply inttForAppMaybeInttBack in H1;auto.

    split.
    invertBool H2.
    intro.
    apply H2.
    apply isCProviderBool_iff;auto.

    exists c0.
    split;auto.

    split.
    invertBool H5.
    intro.
    apply H5.
    apply isCProviderBool_iff;auto.

    split.
    rewrite negb_false_iff in H6.
    apply canStartCorrect;auto.
    split;intros.
    discriminate H.
    destruct H.
    discriminate H.

  - destruct (brperm i).
    case_eq (appHasPermissionBool a p s);intro.
    destruct H.
    split.
 -- rewrite negb_false_iff in H3.
    apply canRunBool_canRun. auto.
 -- exists c.

    split.
    apply inttForAppMaybeInttBack in H1;auto.

    split.
    invertBool H2.
    intro.
    apply H2.
    apply isCProviderBool_iff;auto.

    exists c0.
    split;auto.

    split.
    invertBool H5.
    intro.
    apply H5.
    apply isCProviderBool_iff;auto.

    split.
    rewrite negb_false_iff in H6.
    apply canStartCorrect;auto.
    split;intros.
    discriminate H.
    destruct H.
    exists p.
    rewrite <-appHasPermissionCorrect in H7;auto.
 -- exists not_enough_permissions.
    split;auto.
    split;auto.
    split;auto.
    split;auto.
    unfold not.
    intros.
    inversion H7.
    inversion H8.
    exists p.
    split;auto.
    invertBool H7.
    intro.
    apply H7.
    apply appHasPermissionCorrect;auto.

 -- destruct H.
    split.
    rewrite negb_false_iff in H3.
    apply canRunBool_canRun. auto.
    exists c.

    split.
    apply inttForAppMaybeInttBack in H1;auto.

    split.
    invertBool H2.
    intro.
    apply H2.
    apply isCProviderBool_iff;auto.

    exists c0.
    split;auto.

    split.
    invertBool H5.
    intro.
    apply H5.
    apply isCProviderBool_iff;auto.

    split.
    rewrite negb_false_iff in H6.
    apply canStartCorrect;auto.
    split;intros.
    discriminate H.
    destruct H.
    destruct H7;auto.
  - exists instance_not_running.
    split;auto.
  - exists no_such_intt.
    split;auto.
    split;auto.
    intro.
    destruct H2.
    apply inttForAppMaybeIntt in H2;auto.
    rewrite H2 in H1.
    discriminate H1.
Qed.

Lemma receiveIntentIsSound : forall (s:System) (i:Intent) (ic:iCmp) (a:idApp) (sValid: validstate s),
        exec s (receiveIntent i ic a) (system (step s (receiveIntent i ic a))) (response (step s (receiveIntent i ic a))).
Proof.
    intros.
    unfold exec.
    split.
    auto.
    elim (classic (pre (receiveIntent i ic a) s));intro.
    left.
    simpl.
    assert(receiveIntent_pre i ic a s = None).
    unfold receiveIntent_pre.
    destruct H as [CR H].
    destruct H.
    destruct_conj H.
    assert (maybeIntentForAppCmp i a ic s = Some x) as maybeintent.
    apply inttForAppMaybeIntt;auto.
    rewrite maybeintent.
    rewrite isCProviderBool_iff in H.
    rewrite not_true_iff_false in H.
    rewrite H.
    destruct H2.
    destruct_conj H1.
    rewrite H2.
    rewrite isCProviderBool_iff in H1.
    rewrite not_true_iff_false in H1.
    rewrite H1.
    assert (canStartBool x0 x s = true).
    apply canStartCorrect;auto.
    rewrite H5.
    assert (negb true=false).
    rewrite negb_false_iff.
    auto.
    rewrite H7.
    case_eq (intType i);intros.
    case_eq (path (data i));intros.
    assert (existsb (receiveIntentCmpRequirements x0 u s (intentActionType i)) (getAllComponents s)=true).
    rewrite existsb_exists.
    specialize (H4 H8 u H9).
    destruct H4.
    destruct_conj H4.
    exists (cmpCP x1).
    unfold receiveIntentCmpRequirements.
    split.
    unfold getAllComponents.
    destruct H10.
    destruct H10.
    destruct H10.
    rewrite in_concat.
    exists (cmp x3).
    rewrite in_app_iff.
    destruct H10.
    split;auto.
    destruct H10.
    left.
    rewrite in_map_iff.
    exists x3.
    split;auto.
    apply inGetValuesBack.
    exists (Value idApp x3).
    split;auto.
    rewrite in_map_iff.
    exists x2.
    split;auto.
    apply (ifManifestThenInApps s sValid x2 x3);auto.
    right.
    rewrite in_map_iff.
    destruct H10.
    destruct_conj H10.
    exists x4.
    rewrite H16.
    auto.
    assert (existsResBool x1 u s = true).
    apply existsRes_iff;auto.
    assert (canGrantBool x1 u s=true).
    apply canGrantCorrect;auto.
    unfold canReadBool.
    unfold canWriteBool.
    unfold canRead in H12.
    unfold canWrite in H12.
    rewrite H11.
    rewrite H13.
    case_eq (intentActionType i);intros; rewrite H14 in H12;destruct H12.
    assert (canDoThisBool x0 x1 s readE=true).
    apply canDoThisBoolCorrect;auto.
    rewrite H15;auto.
    assert (delPermsBool x0 x1 u Read s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H15;auto.
    rewrite orb_true_r.
    auto.

    assert (canDoThisBool x0 x1 s writeE=true).
    apply canDoThisBoolCorrect;auto.
    rewrite H15;auto.
    assert (delPermsBool x0 x1 u Write s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H15;auto.
    rewrite orb_true_r.
    auto.

    destruct H12.
    assert (canDoThisBool x0 x1 s readE=true).
    apply canDoThisBoolCorrect;auto.
    rewrite H16;auto.

    destruct H15.
    assert (canDoThisBool x0 x1 s writeE=true).
    apply canDoThisBoolCorrect;auto.
    rewrite H17;auto.
    assert (delPermsBool x0 x1 u Write s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H17;auto.
    rewrite orb_true_r.
    auto.

    destruct H15.
    assert (canDoThisBool x0 x1 s writeE=true).
    apply canDoThisBoolCorrect;auto.
    rewrite H16;auto.
    assert (delPermsBool x0 x1 u Read s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H17;auto.
    rewrite orb_true_r.
    auto.

    assert (delPermsBool x0 x1 u Read s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H16;auto.
    rewrite orb_true_r.
    auto.
    assert (delPermsBool x0 x1 u Write s=true).
    apply delPermsBoolCorrect;auto.
    rewrite H17;auto.
    rewrite orb_true_r.
    auto.

    apply canRun_canRunBool in CR.
    rewrite CR. simpl.

    rewrite H10.
    auto.
    auto.
    apply canRun_canRunBool in CR.
    rewrite CR. simpl.
    auto. auto.
    apply canRun_canRunBool in CR.
    rewrite CR. simpl. auto. auto.
    apply canRun_canRunBool in CR.
    rewrite CR. simpl.
    case_eq (brperm i);intros.
    assert (appHasPermissionBool a p s=true).
    assert (exists p : Perm, brperm i = Some p /\ RuntimePermissions.appHasPermission a p s).
    apply H6.
    split;auto.
    unfold not;intros.
    rewrite H9 in H10.
    inversion H10.
    destruct H10.
    destruct H10.
    rewrite H10 in H9.
    inversion H9.
    rewrite H13 in H11.
    apply appHasPermissionCorrect;auto.
    rewrite H10;auto.
    auto. auto.

    unfold receiveIntent_safe;simpl.
    rewrite H0;simpl.
    split;auto.
    split;auto.
    apply receiveIntentCorrect;auto.
    right.
    apply notPreReceiveIntentThenError;auto.
Qed.
End ReceiveIntent.


Require Import LayerDeps.
Require Import Ident.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableDataOpsIntro.Spec.
Require Import BaremoreHandler.Spec.
Require Import AbsAccessor.Spec.
Require Import RmiSMC.Spec.
Require Import RunSMC.Spec.
Require Import TableDataSMC.Spec.

Local Open Scope Z_scope.

Section Layer.

  Context `{real_params: RealParams}.

  Section InvDef.

    Record high_level_invariant (adt: RData) :=
      mkInvariants { }.

    Global Instance TableDataSMC_ops : CompatDataOps RData :=
      {
        empty_data := empty_adt;
        high_level_invariant := high_level_invariant;
        low_level_invariant := fun (b: block) (d: RData) => True;
        kernel_mode adt := True
      }.

  End InvDef.

  Section InvInit.

    Global Instance TableDataSMC_prf : CompatData RData.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

  End InvInit.

  Context `{Hstencil: Stencil}.
  Context `{Hmem: Mem.MemoryModelX}.
  Context `{Hmwd: UseMemWithData mem}.

  Section InvProof.

    Global Instance smc_rtt_create_inv: PreservesInvariants smc_rtt_create_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rtt_destroy_inv: PreservesInvariants smc_rtt_destroy_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rtt_map_inv: PreservesInvariants smc_rtt_map_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rtt_unmap_inv: PreservesInvariants smc_rtt_unmap_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_data_create_inv: PreservesInvariants smc_data_create_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_data_destroy_inv: PreservesInvariants smc_data_destroy_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_data_create_unknown_inv: PreservesInvariants smc_data_create_unknown_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance data_destroy_inv: PreservesInvariants data_destroy_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance el3_sync_lel_inv: PreservesInvariants el3_sync_lel_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance enter_rmm_inv: PreservesInvariants enter_rmm_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance data_create_unknown_inv: PreservesInvariants data_create_unknown_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_granule_delegate_inv: PreservesInvariants smc_granule_delegate_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance exit_rmm_inv: PreservesInvariants exit_rmm_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_granule_undelegate_inv: PreservesInvariants smc_granule_undelegate_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rec_destroy_inv: PreservesInvariants smc_rec_destroy_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rec_create_inv: PreservesInvariants smc_rec_create_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_rec_run_inv: PreservesInvariants smc_rec_run_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance data_create_inv: PreservesInvariants data_create_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance read_reg_inv: PreservesInvariants read_reg_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance assert_cond_inv: PreservesInvariants assert_cond_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_realm_create_inv: PreservesInvariants smc_realm_create_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance user_step_inv: PreservesInvariants user_step_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_realm_activate_inv: PreservesInvariants smc_realm_activate_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

    Global Instance smc_realm_destroy_inv: PreservesInvariants smc_realm_destroy_spec.
    Proof.
      constructor; intros; simpl; eauto.
      constructor.
    Qed.

  End InvProof.

  Section LayerDef.

    Definition TableDataSMC_fresh : compatlayer (cdata RData) :=
      _smc_rtt_create ↦ gensem smc_rtt_create_spec
        ⊕ _smc_rtt_destroy ↦ gensem smc_rtt_destroy_spec
        ⊕ _smc_rtt_map ↦ gensem smc_rtt_map_spec
        ⊕ _smc_rtt_unmap ↦ gensem smc_rtt_unmap_spec
        ⊕ _smc_data_create ↦ gensem smc_data_create_spec
        ⊕ _smc_data_destroy ↦ gensem smc_data_destroy_spec
        ⊕ _smc_data_create_unknown ↦ gensem smc_data_create_unknown_spec
      .

    Definition TableDataSMC_passthrough : compatlayer (cdata RData) :=
      _data_destroy ↦ gensem data_destroy_spec
        ⊕ _el3_sync_lel ↦ gensem el3_sync_lel_spec
        ⊕ _enter_rmm ↦ gensem enter_rmm_spec
        ⊕ _data_create_unknown ↦ gensem data_create_unknown_spec
        ⊕ _smc_granule_delegate ↦ gensem smc_granule_delegate_spec
        ⊕ _exit_rmm ↦ gensem exit_rmm_spec
        ⊕ _smc_granule_undelegate ↦ gensem smc_granule_undelegate_spec
        ⊕ _smc_rec_destroy ↦ gensem smc_rec_destroy_spec
        ⊕ _smc_rec_create ↦ gensem smc_rec_create_spec
        ⊕ _smc_rec_run ↦ gensem smc_rec_run_spec
        ⊕ _data_create ↦ gensem data_create_spec
        ⊕ _read_reg ↦ gensem read_reg_spec
        ⊕ _assert_cond ↦ gensem assert_cond_spec
        ⊕ _smc_realm_create ↦ gensem smc_realm_create_spec
        ⊕ _user_step ↦ gensem user_step_spec
        ⊕ _smc_realm_activate ↦ gensem smc_realm_activate_spec
        ⊕ _smc_realm_destroy ↦ gensem smc_realm_destroy_spec
      .

    Definition TableDataSMC := TableDataSMC_fresh ⊕ TableDataSMC_passthrough.

  End LayerDef.

End Layer.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableAux.Spec.
Require Import AbsAccessor.Spec.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsRef3.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition smc_rtt_create_spec0 (rtt_addr: Z64) (rd_addr: Z64) (map_addr: Z64) (level: Z64) (adt: RData) : option (RData * Z64) :=
    match rtt_addr, rd_addr, map_addr, level with
    | VZ64 _rtt_addr, VZ64 _rd_addr, VZ64 _map_addr, VZ64 _level =>
      let _ret := 0 in
      rely is_int64 _map_addr;
      rely is_int64 _level;
      when _t'1 == validate_table_commands_spec (VZ64 _map_addr) (VZ64 _level) (VZ64 1) (VZ64 3) (VZ64 3) adt;
      rely is_int _t'1;
      rely is_int64 _t'1;
      let _ret := _t'1 in
      if (_ret =? 0) then
        rely is_int64 _rtt_addr;
        when'' _g_rtt_base, _g_rtt_ofst, adt == find_lock_granule_spec (VZ64 _rtt_addr) (VZ64 1) adt;
        rely is_int _g_rtt_ofst;
        when _t'6 == is_null_spec (_g_rtt_base, _g_rtt_ofst) adt;
        rely is_int _t'6;
        if (_t'6 =? 1) then
          let _ret := 1 in
          Some (adt, (VZ64 _ret))
        else
          rely is_int64 _rd_addr;
          when'' _g_rd_base, _g_rd_ofst, adt == find_lock_granule_spec (VZ64 _rd_addr) (VZ64 2) adt;
          rely is_int _g_rd_ofst;
          when _t'5 == is_null_spec (_g_rd_base, _g_rd_ofst) adt;
          rely is_int _t'5;
          if (_t'5 =? 1) then
            let _ret := 1 in
            when adt == granule_unlock_spec (_g_rtt_base, _g_rtt_ofst) adt;
            Some (adt, (VZ64 _ret))
          else
            when' _ret, adt == table_create3_spec (_g_rd_base, _g_rd_ofst) (VZ64 _map_addr) (VZ64 _level) (_g_rtt_base, _g_rtt_ofst) (VZ64 _rtt_addr) adt;
            rely is_int64 _ret;
            when adt == granule_unlock_spec (_g_rd_base, _g_rd_ofst) adt;
            when adt == granule_unlock_spec (_g_rtt_base, _g_rtt_ofst) adt;
            Some (adt, (VZ64 _ret))
      else
        Some (adt, (VZ64 _ret))
     end
    .

End SpecLow.


(******************************************************************************)
(** * RC11 is weaker than IMM_S   *)
(******************************************************************************)

Require Import Classical Peano_dec.
From hahn Require Import Hahn.

Require Import Events.
Require Import Execution.
Require Import Execution_eco.
Require Import imm_bob imm_s_ppo.
Require Import imm_s_hb.
Require Import imm_s.
Require Import RC11.

Set Implicit Arguments.

Section RC11_TO_IMM_S.

Variable G : execution.

Notation "'E'" := (acts_set G).
Notation "'sb'" := (sb G).
Notation "'rf'" := (rf G).
Notation "'co'" := (co G).
Notation "'rmw'" := (rmw G).
Notation "'data'" := (data G).
Notation "'addr'" := (addr G).
Notation "'ctrl'" := (ctrl G).
Notation "'rmw_dep'" := (rmw_dep G).

Notation "'fr'" := (fr G).
Notation "'eco'" := (eco G).
Notation "'coe'" := (coe G).
Notation "'coi'" := (coi G).
Notation "'deps'" := (deps G).
Notation "'rfi'" := (rfi G).
Notation "'rfe'" := (rfe G).

Notation "'detour'" := (detour G).

Notation "'rs'" := (rs G).
Notation "'release'" := (release G).
Notation "'sw'" := (sw G).
Notation "'hb'" := (hb G).

Notation "'ar_int'" := (ar_int G).
Notation "'ppo'" := (ppo G).
Notation "'bob'" := (bob G).

Notation "'ar'" := (ar G).

Notation "'lab'" := (lab G).
Notation "'loc'" := (loc lab).
Notation "'val'" := (val lab).
Notation "'mod'" := (mod lab).
Notation "'same_loc'" := (same_loc lab).

Notation "'R'" := (fun a => is_true (is_r lab a)).
Notation "'W'" := (fun a => is_true (is_w lab a)).
Notation "'F'" := (fun a => is_true (is_f lab a)).
Notation "'Rlx'" := (fun a => is_true (is_rlx lab a)).
Notation "'Acq'" := (fun a => is_true (is_acq lab a)).
Notation "'Rel'" := (fun a => is_true (is_rel lab a)).
Notation "'Acq/Rel'" := (fun a => is_true (is_ra lab a)).
Notation "'Sc'" := (fun a => is_true (is_sc lab a)).

(******************************************************************************)
(** relations are contained in the corresponding ones **  *)
(******************************************************************************)

Lemma s_imm_consistentimplies_rc11_consistent (WF: Wf G)
      (COND: ⦗R \₁ Acq⦘ ⨾ sb ⨾ ⦗W \₁ Rel⦘ ⊆ sb ⨾ ⦗F ∩₁ Acq/Rel⦘ ⨾ sb ∪ ⦗R⦘ ⨾ deps ⨾ ⦗W⦘ ∪ rmw) sc
      (IPC : imm_s.imm_psc_consistent G sc) :
  rc11_consistent G.
Proof using.
  cdes IPC. cdes IC.
  red. splits; auto.
  rewrite rfi_union_rfe with (G:=G).
  unfold Execution.rfi; rewrite inclusion_inter_l2, <- unionA, unionK.
  eapply acyclic_ud with (adom := W) (bdom := R); eauto using sb_acyclic.
  1-2: by destruct WF; unfold Execution.rfe; rewrite wf_rfD; eauto using minus_doma, minus_domb with hahn.
  assert (T:= @sb_trans G); relsf; clear T.
  eapply irreflexive_inclusion, Cext; apply inclusion_t_t2.
  unfold imm_s.ar, imm_s_ppo.ar_int; unionL; eauto with hahn.
  arewrite (R ≡₁ (R ∩₁ Acq) ∪₁ (R \₁ Acq)).
    by unfolder; split; ins; desf; destruct (is_acq lab x); auto.
  rewrite id_union; relsf; unionL.
    by rewrite inclusion_seq_eqv_r at 1; unfold imm_bob.bob; auto 10 with hahn.
  arewrite (W ≡₁ (W ∩₁ Rel) ∪₁ (W \₁ Rel)) at 1.
    by unfolder; split; ins; desf; destruct (is_rel lab x); auto.
  rewrite id_union; relsf; unionL.
    by rewrite inclusion_seq_eqv_l at 1; unfold imm_bob.bob, imm_bob.fwbob; auto 10 with hahn.
  rewrite COND.
  sin_rewrite rmw_in_ppo; auto.
  arewrite (⦗R⦘ ⨾ deps ⨾ ⦗W⦘ ⊆ ppo).
  { rewrite <- deps_rfi_in_ppo.
    sin_rewrite (ct_step deps).
    rewrite unionC, ct_unionE.
    basic_solver. }
  unionL.
  { rewrite <- seq_eqvK, seqA, <- seqA.
    apply inclusion_step2_ct; unfold imm_bob.bob, imm_bob.fwbob; auto 10 with hahn. }
  all: etransitivity; [|by apply ct_step].
  all: basic_solver 20.
Qed.

End RC11_TO_IMM_S.