(*
date: 04/09/2018
author: Teng Zhang
*)

(*definition of semantic rules*)

Require Import
  Coq.Strings.String
  Coq.Lists.List
  Coq.Bool.Bool
  Coq.Vectors.Vector
  Coq.ZArith.ZArith
  Coq.ZArith.Zdigits
  Coq.QArith.QArith_base
  Coq.QArith.Qabs
  Coq.FSets.FMapList
  Coq.FSets.FMapFacts
  Coq.Init.Notations
  Coq.omega.Omega.

Require Import Coq.Sorting.Permutation.
Require Export SmedlAST_submission.
Require Export SMEDL_helper.

Set Implicit Arguments.
Set Boolean Equality Schemes.

Unset Strict Implicit.
Unset Printing Implicit Defensive.
Generalizable All Variables.

Require Import Coq.Strings.Ascii.

Section semantic_rule.

(*from state of the state machine and the event instance, get the current step*)
  Definition stepStateMap := (scenario_state*event_instance)->option step.

  Definition stepStateMap' := (scenario_state*event_instance*scenario)->option (step).

(*construct stepStateMap*)
Definition update_stepStateMap (map: stepStateMap) (key: scenario_state*event_instance) (value: option step): stepStateMap :=
fun (key':scenario_state*event_instance) => if string_dec (fst key') (fst key)
                                                                          then if event_instance_dec (snd key') (snd key)
                                                                                then value
                                                                                else map key'
                                                                       else map key'.

(*given scenario state and event definition, return corresponding list of event_instances*)
Definition transitionEventMap := (option scenario_state* option event_definition) -> list event_instance.
(*construct transtionCondtionMap*)
Definition update_transitionEventMap (map:transitionEventMap) (key:option scenario_state* option event_definition) (value: event_instance) : transitionEventMap :=
fun (key': option scenario_state*option event_definition) =>
match fst key', snd key', fst key, snd key with
| Some fk',Some sk', Some fk,Some sk => if string_dec (fk') (fk)
                                 then if  string_dec (eventId (sk)) (eventId (sk'))
                                                  then value::(map key)
                                          else map key'
                         else map key'
| _,_,_,_ =>map key'
end.

(*map from state to its possible triggering event*)
Definition stateEventDefMap := option scenario_state -> list event_definition.
Definition update_stateEventDefMap (map:stateEventDefMap) (key:option scenario_state) (ev: event_definition) : stateEventDefMap :=
fun (key': option scenario_state) => match key' with
                                                        | None => nil
                                                        | Some s => match key with
                                                                            | None => nil
                                                                            | Some s' => if string_dec s s' then ev::(map (key')) else map key'
                                                                            end
                                                        end
.

Print object.
Print find.

Definition getStepFromMap (mon:object) (e:scenario_state*event_instance) : option step
  := match find (fun (x:(scenario_state * event_instance * option step)) => if string_dec (fst (fst x)) (fst e)
                               then
                                 if (event_instance_dec (snd (fst x)) (snd e))
                                 then
                                   true
                                 else
                                   false
                               else
                                 false
                ) (stateEvStepMap mon) with
     | Some (s, ei, x) => x
     | None => None
     end.

(*environment*)
(*scenario_state -> list event_definition*)
Parameter stEvMap: stateEventDefMap.
(*scenario_state*event_definition -> list event_instance*)
Parameter transEvMap : transitionEventMap.
(*scenario_state*event_instance -> option step*)
Parameter stpStMap': stepStateMap'.
Parameter stpStMap: stepStateMap.
Parameter eventList: list event_definition.

(*data structure*)

(*used in configuration*)
(*data structure to represent the event raised*)
(*pathE*)

Definition monitor : Set := object.

(*current state of the monitor*)
Record configuration (M : monitor) : Type :={
  datastate : value_env;
  controlstate : scenario_env;
  raisedevents :  list raisedEvent; (*all raised events, removed after being handled*)
  exportedevents: list raisedEvent; (*only for exported events*)
  finishedscenarios: list scenario;(*no change, using more strict definition*)
  sceEventMap: list (scenario*event_definition);
}.

Definition sceEventMap_dec (n m : list (scenario*event_definition)) : {n = m} + { n <> m}.
Proof. pose proof scenario_dec. pose proof event_definition_dec. repeat decide equality.
Qed.

Definition configuration_dec {M : monitor} (n m : configuration M) : {n = m} + { n <> m}.
Proof. pose proof expr_eq_dec. repeat decide equality.
Qed.

Definition scenarioInclusion `(conf: configuration M) : Prop:=
incl  (finishedscenarios conf) (dom (controlstate conf)).

(*we assume that state update only updates state variables so that domain of (datastate conf) will never change, meaning
uniq (datastate conf) always holds
Another assumption is that the update will follow the typechecking rule of normal programming languages*)

Inductive evnConsist : typ_env -> value_env -> Prop :=
| e_con_base: evnConsist nil nil
| e_con_ind: forall n (ty:typ) v te ev, evnConsist te ev -> evnConsist (((AIdent n),ty)::te) (((AIdent n),(ty,v))::ev).

Definition tyEnvPair (t:typ) (r:range_typ) :=
      match (t,r) with
        | (Int, (inl (inl (inl (inl _))))) => True
        | (Float, (inl (inl (inl (inr _))))) => True
        | (Str, (inl (inl (inr _)))) => True
        | (Bool, (inl (inr _))) => True
        | (Pointer, (inr _)) => True
        | (Thread, (inr _)) => True
        | (Opaque, (inr _)) => True
        | _ => False
      end.

Inductive tyEnv: value_env -> Prop :=
| ty_base: tyEnv nil
| ty_ind: forall n t r ve, tyEnv ve -> tyEnvPair t r -> tyEnv (((AIdent n),(t,r))::ve).

Lemma tyEnvApp: forall v1 v2,
    tyEnv v1 ->
    tyEnv v2 ->
    tyEnv (v1++v2).
Proof.
  intro v1;induction v1.
  -
    intros. simpl.
    auto.
  -
    intros.
    SearchAbout app.
    rewrite <- app_comm_cons.

    inversion H; subst.
    apply ty_ind;auto.
Qed.

Lemma valConsist: forall env t_env   s ty,
    evnConsist t_env env ->
    tyEnv env ->
    HasTy t_env (EAtom (AIdent s)) ty ->
    (exists v, In (AIdent s, (ty, v)) env).
Proof.
  intro env;induction env.
  -  intros. inversion H. subst. inversion H1.
     subst. SearchAbout find. apply find_some in H3.
     destruct H3. inversion H2.
  - intros.
    inversion H;inversion H0;subst.
    inversion H1.
    subst. simpl.
    inversion H6;subst. simpl in H3.
    destruct (atom_eq_dec (AIdent n) (AIdent s)). inversion e;subst.
    inversion H3;subst. exists v;left;auto.
    assert (exists v0 : range_typ, In (AIdent s, (ty, v0)) env).
    apply IHenv with (t_env:=te);auto.
    apply HasTy_Var;auto.
    destruct H2. exists x;right;auto.
Qed.

Lemma domIn: forall (A B:Type) (s:A) (x:B) env,
In  (s,x) env ->
In s (dom env).
Proof. intros.
generalize dependent s.
generalize dependent x.
induction env;intros.
- inversion H.
- destruct H. rewrite H. left;auto.
simpl. right. apply IHenv with (x:=x). auto.
Qed.

Lemma  getValueIn: forall ds s v t,  uniqList (dom ds) -> In ((AIdent s), (t, v)) (ds) -> getValue (AIdent s) ds = Some v.
Proof. intros.
induction ds. inversion H0.
simpl. destruct a;auto.
simpl. destruct p;auto.

destruct (atom_eq_dec (AIdent s) a).
subst.  inversion H;subst. simpl in H0. destruct H0.
inversion H0;auto. apply domIn in H0.  contradiction.
apply IHds. inversion H;auto. simpl in H0.
destruct H0. inversion H0;subst. contradiction.
auto.
Qed.

Lemma tyEnvIn: forall ve s ty x,
    In (AIdent s, (ty, x)) ve ->
    tyEnv ve ->
    tyEnvPair ty x.
Proof. intro ve.
  induction ve;intros.
- inversion H.
- inversion H0;subst.
  inversion H. inversion H1;subst.
  auto.
  apply IHve with (s:=s);auto.
Qed.

Check dom.

Record correct_configuration `(conf: configuration M) : Prop :={
(*ds_uniq: uniq (datastate conf);*)
(*ds_type_check : forall prod, In prod (datastate conf) -> typeCheck prod;*)
cs_non_empty: dom (controlstate conf)<> nil;
sce_state_no_empty: forall sce, In sce (dom (controlstate conf)) -> getScenarioState sce (controlstate conf) <> None;
finish_uniq: uniqList (finishedscenarios conf);
cs_dom_uniq: uniqList (dom (controlstate conf));
inclusion: scenarioInclusion conf;
correct_mon : correct_object M;
ds_tyEnv:tyEnv (datastate conf);
raise_in: (forall e, In e (raisedevents conf) -> In (eventDefinition e) (events M));
(*export_in: (forall e, In e (exportedevents conf) -> In (eventDefinition e) (events (monitor_obj conf)));*)
cs_consist: dom (controlstate conf) = (scenarios M);
(*cs_state_consist: forall sce st e0 s0, In (sce,st) (controlstate conf) -> In (st, e0, Some s0) (stateEvStepMap (monitor_obj conf)) -> (In s0 (traces sce) /\  (pre_state s0 = st));
cs_state_consist': forall sce st e0 s0,  In st (sceStateRelation sce) -> In (st, e0, Some s0) (stateEvStepMap (monitor_obj conf)) -> (In s0 (traces sce) /\  (pre_state s0 = st));
sce_state_in: forall sce st, In (sce,st) (controlstate conf) -> In st (sceStateRelation sce);*)
ds_dom_eq: (dom2 (datastate conf)) = ((dsmon M));
ds_consist: evnConsist (dsmon M) (datastate conf);
raised_wellform': forall e,  In e (raisedevents conf) ->
                             wellFormedRaisedEvent e;
raisedType: forall re, In re (raisedevents conf) -> eventKind (eventDefinition re) = Internal \/ eventKind (eventDefinition re) = Imported;
sceStateCorrect: forall sce s, In (sce,s) (controlstate conf) -> In (sce, s) (stateScenarioMap M);
sceEventMapRange : Permutation (dom (sceEventMap conf)) (finishedscenarios conf);
sceEventMapAlphabet:  forall sce e, In (sce,e) (sceEventMap conf) -> In e (alphabet sce);
raise_in_finished: forall sce e,  In (sce,e) (sceEventMap conf) -> In e (events M);
raisedType_finished: forall sce e, In (sce,e) (sceEventMap conf)-> eventKind e = Internal \/ eventKind e = Imported;
(*ds_ty_eq: (forall n t1 t2, In (n,t1) (dom2 (datastate conf)) -> (In (n,t2) ( (dsmon (monitor_obj conf)))) -> t1 = t2)*)
(*sceEventMapRange:  dom (sceEventMap conf) = (finishedscenarios conf);*)
                                                            }.

Definition importEventBool (ev:event_definition) : bool :=
if  (eventKind_dec (eventKind ev) Imported) then true else  false.

Print transitionEventMap.
Print object.

Definition op_string_dec (n m : option string) : {n = m} + { n <> m}.
Proof.  destruct n. destruct m. pose proof string_dec.
        destruct H with (s1:=s) (s2:=s0).   left;auto. rewrite e ;auto.
        right. unfold not. intros. inversion H0. contradiction.
        right. unfold not. intros. inversion H.
        destruct m.
        right. unfold not. intros. inversion H.
        left;auto.
Defined.

Definition op_event_definition_dec (n m : option event_definition) : {n = m} + { n <> m}.
Proof.
  destruct n;destruct m.
  pose proof event_definition_dec.
  destruct H with (n:=e) (m:=e0);auto. left. rewrite e1;auto.
  right. unfold not. intros. inversion H0. contradiction.
  right. unfold not. intros. inversion H.
  right. unfold not;intros;inversion H. left;auto.

Defined.

Fixpoint transEvMapFunc
          (l : list  (option scenario_state * option event_definition *
                      list event_instance)) (f: (option scenario_state * option event_definition)) :  option (list event_instance) :=
  match l with
  | nil => None
  | ((a, b),c) :: l' => if op_string_dec a (fst f) then
                          if op_event_definition_dec b (snd f) then
                            Some c
                          else
                            transEvMapFunc l' f
                        else
                          transEvMapFunc l' f
  end.

Fixpoint transEvMapFunc'
          (l : list  (option scenario_state * option event_definition *
                      list event_instance)) (f: (option scenario_state * option event_definition)) :   (list event_instance) :=
  match l with
  | nil => nil
  | ((a, b),c) :: l' => if op_string_dec a (fst f) then
                          if op_event_definition_dec b (snd f) then
                             c
                          else
                            transEvMapFunc' l' f
                        else
                          transEvMapFunc' l' f
  end.

Print object.

Definition transEvMapFuncMon (mon: object)
          (f: (option scenario_state * option event_definition)) :  option (list event_instance) :=
    transEvMapFunc (stateEvDefInstanceMap mon) f.

Print dom2.

Lemma stateEvDefInstanceMapEquiv' : forall (l : list  (option scenario_state * option event_definition *
                      list event_instance)),
  uniqList (dom l) ->  (forall st ev eList, In (Some st, Some ev, eList) l
                       <-> transEvMapFunc l (Some st, Some ev) = Some eList).
Proof.
  intro l;induction l.
  - split.  intros.
     inversion H0.     intros. simpl in H0. inversion H0.
  - intros.
    simpl in H.
    split;intros.
    inversion H0. subst.
    simpl.
    simpl in *.

    destruct (string_dec st st);auto. Focus 2. contradiction.
    destruct (event_definition_dec ev ev). Focus 2. contradiction. auto.
    (*Check eq_rec_r.
    destruct (eq_rec_r (fun s : string => {Some s = Some st} + {Some s <> Some st}) (left eq_refl) e).
    Focus 2. contradiction.
    destruct (eq_rec_r (fun s : string => {Some s = Some st} + {Some s <> Some st}) (left eq_refl)).   Focus 2. contradiction.

    destruct (op_string_dec (Some st) (Some st)).
    destruct (op_event_definition_dec (Some ev) (Some ev)).
     auto.
     contradiction.
     contradiction.*)

     simpl.
     destruct a. destruct p.
     destruct (op_string_dec o (Some st)).
     subst.
     destruct (op_event_definition_dec o0 (Some ev)).
     simpl in H. inversion H;subst.
     SearchAbout dom.
     apply domIn in H1. contradiction. apply IHl;auto. inversion H;subst. auto.
     apply IHl;auto. inversion H;subst. auto.
     simpl in *.
     destruct a;destruct p.
     destruct (op_string_dec o (Some st)).
     destruct (op_event_definition_dec o0 (Some ev)).
     subst.
     simpl in H. inversion H0;subst. left;auto.
     subst. apply IHl in H0. right;auto.
     inversion H;subst;auto.
     apply IHl in H0. right;auto.
     inversion H;subst;auto.
Qed.
Print object.
Print stepStateMap'.

Definition op_stpMap_dec (n m :  (scenario_state * event_instance * scenario)) : {n = m} + { n <> m}.
Proof.
  destruct n;destruct m. destruct p;destruct p0.
  pose proof string_dec. pose proof event_instance_dec.
  pose proof scenario_dec.
  destruct H with (s1:=s1) (s2:=s2); destruct H0 with (n:=e) (m:=e0); destruct H1 with (n:=s) (m:=s0);auto. left. rewrite e1;rewrite e2;rewrite e3;auto. right. unfold not. intros.
  inversion H2. contradiction.
right. unfold not. intros.
inversion H2. contradiction.
right. unfold not. intros.
inversion H2. contradiction.
right. unfold not. intros.
inversion H2. contradiction.
right. unfold not. intros.
inversion H2. contradiction.
right. unfold not. intros.
inversion H2. contradiction.
right. unfold not. intros.
  inversion H2. contradiction.
Defined.

Fixpoint stpStpMapFunc (l : list (scenario_state * event_instance * scenario * option step))
         (f: (scenario_state * event_instance * scenario)) : option step :=
  match l with
 |  nil => None
 | (a,d)::l' => if op_stpMap_dec a f then
                  d
                else
                  stpStpMapFunc l' f
 end.

Print object.

Definition stpStpMapFuncMon (mon: object)
          (f: (scenario_state * event_instance * scenario)) :  option step :=
    stpStpMapFunc (stateEvStepMap'  mon) f.

Lemma stpStMapEquivLem: forall l,
  uniqList (dom l) -> (forall st ei stp sce, In (st,ei,sce,Some stp) l <-> stpStpMapFunc l (st, ei,sce) = Some stp).
Proof.
  intro l;induction l.
- split;intros.
  inversion H0. simpl in H0.
  inversion H0.
-
  split;intros.
  simpl in H0.
  destruct H0;subst.
  simpl.
  destruct (string_dec st st). destruct (event_instance_dec ei ei ).
  destruct (scenario_dec sce sce ). auto. contradiction. contradiction. contradiction.
 (* destruct (op_stpMap_dec (st, ei, sce) (st, ei, sce)). auto.
  contradiction.*)
  inversion H;subst.
  destruct a. simpl in *.
  destruct (op_stpMap_dec p (st, ei, sce)).
  subst.
  inversion H;subst.
  apply domIn in H0. contradiction.
  apply IHl;auto.
  simpl in *.
  destruct a.
  subst.
  destruct (op_stpMap_dec p (st, ei, sce)).
  subst. left;auto.
  apply IHl in H0. right;auto.
  inversion H;subst;auto.
Qed.

Fixpoint getEventInstances' (ev:event_definition) (sce_env: scenario_env) (sceList: list scenario) (l : list  (option scenario_state * option event_definition *
                      list event_instance)): list event_instance :=
match sce_env with
| nil => nil
| (s,state)::env'=>   if inList scenario_dec s (sceList)  then
                                (getEventInstances' ev env' sceList l)
                      else
                        match (transEvMapFunc l (Some state, Some ev)) with
                        | None => (getEventInstances' ev env' sceList l)
                        | Some l' =>
                          mergeList' l' (getEventInstances' ev env' sceList l) (event_instance_dec)
                       end
end.

Definition getEventInstances (ev:event_definition) `(conf: configuration M) (l : list  (option scenario_state * option event_definition *
                      list event_instance)) : list event_instance :=
getEventInstances' ev (controlstate conf) (finishedscenarios conf) l.

(*get all variables from an expression*)
Fixpoint getVariables (e:expr) : list atom :=
match e with
| EOr x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EAnd x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EEq x y  => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| ELt x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| ELe x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EPlus x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EMult x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EDiv x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| EMod x y => mergeList' (getVariables x) (getVariables y) (atom_eq_dec)
| ENot x => getVariables x
| EAtom x => match x with
                     | AIdent i => (AIdent i)::nil
                     | _ => nil
                     end
end.

Fixpoint getUpdated (a:  action) : list atom :=
match a with
| StateUpdate (LExp (AIdent s)) ex =>  (AIdent s)::nil
| Seq a1 a2 => let r1 := getUpdated a1 in
                 let r2 :=  getUpdated a2 in
                 mergeList' r1 r2 (atom_eq_dec)
| _ => nil
end.

Fixpoint getVarsFromExprList (lst: list expr): list atom :=
match lst with
| nil => nil
| e::lst' => mergeList' (getVariables e) (getVarsFromExprList  lst') (atom_eq_dec)
end.

Fixpoint getUsedFromActions (a: action) : list atom :=
  match a with
  | StateUpdate (LExp (AIdent s)) ex => (getVariables ex)

  | RaiseStmt n lst =>  (getVarsFromExprList lst)
  | Seq a1 a2 => let r1 := getUsedFromActions a1 in
                 let r2 :=  getUsedFromActions a2 in
                 mergeList' r1 r2 (atom_eq_dec)
  | _ => nil
  end.

Definition getUpdatedVariablesFromScenario `(conf:configuration M) (stp:step)  : list atom
:= filterListReverse (dom (datastate conf)) (getUpdated (stepActions stp)) (atom_eq_dec).

Definition getUsedVariablesFromScenario `(conf:configuration M) (stp:step)  : list atom
:=
filterListReverse (dom (datastate conf)) (mergeList' (getVariables (eventWhenExpr (stepEvent stp))) (getUsedFromActions (stepActions stp)) (atom_eq_dec)) (atom_eq_dec)
.

Definition getStep  `(conf: configuration M) (sce: scenario) (e: event_instance) : option step :=
match getScenarioState sce (controlstate conf) with
| None => None
| Some s =>  stpStMap (s,e)
end.

(*Definition getStep'  `(conf: configuration M) (sce: scenario) (e: event_instance) : option (step) :=
match getScenarioState sce (controlstate conf) with
| None => None
| Some s =>  stpStMap' (s,e,sce)
end.*)
Print object.

Definition getStep'  `(conf: configuration M) (sce: scenario) (e: event_instance) : option (step) :=
match getScenarioState sce (controlstate conf) with
| None => None
| Some s =>  stpStpMapFunc (stateEvStepMap' M) (s,e,sce)
end.

Definition getStep''  `(conf: configuration M) (sce: scenario) (e: event_instance) : option step :=
match getScenarioState sce (controlstate conf) with
| None => None
| Some s =>  getStepFromMap M (s,e)
end.

(*Definition stpStMapEquiv (mon:object) :=
  (forall st ei stp, In (st,ei,Some stp) (stateEvStepMap mon) <-> stpStMap (st, ei) = Some stp).*)

  (*uniqList (dom2 (stateEvStepMap mon))*)
  (* destruct ((stateEvStepMap mon)). inversion H.
         simpl.
         simpl in H.
         destruct H. rewrite H.
         simpl. destruct (string_dec st st).
         destruct (event_instance_dec ei ei). auto.
         contradiction. contradiction.

         Print getStepFromMap.
         *)

Local Open Scope Z_scope.
Local Open Scope string_scope.

(*(a: atom) (t: typ) (v: range_typ) (en:value_env):*)
(*Fixpoint getValue (a: atom) (en:value_env) : option range_typ :=*)
(*semantics function*)
(*assume that n will be in the set of state variables*)
Print value_env.
Print typ_env.

Fixpoint updateDataState (ven:value_env) (lst: list atom) : value_env :=
match ven with
| nil =>  nil
| (a,v)::ven' => if (inList atom_eq_dec a (lst)) then (a,v)::(updateDataState ven' lst) else (updateDataState ven' lst)
end.

Definition updateControlState (cs:scenario_env) (sce: scenario) (stp: step) :scenario_env :=
updateScenarioState' sce (pro_state stp) cs.

Fixpoint removeEvent' (re : raisedEvent) (lst : list raisedEvent) : list raisedEvent :=
match lst with
| nil => nil
| re' :: lst' => if raisedEvent_dec re re' then removeEvent' re lst' else re'::(removeEvent' re lst')
end.

(*update configuration*)
Print configuration.

Definition configTransition  (env:value_env) (re:raisedEvent) (e:event_instance) (sce : scenario) (stp: step) `(conf: configuration M) : @ErrorOrResult (configuration M) :=
match (execAction (env,nil) (stepActions stp) (filter
             (fun e : event_definition =>
              match eventKind e with
              | Internal => true
              | Imported => false
              | Exported => true
              end) (events M))) with
| Error s => Error s
| Result (ds',res) => let ds'':= updateDataState ds' (dom (datastate conf)) in
                      Result ({|
datastate := ds'';
controlstate := updateControlState (controlstate conf) sce stp;
(*raisedevents := app (filter (fun re => EventKind_beq (eventKind (eventDefinition re)) Internal) res) (removeEvent' re ((raisedevents) conf));
exportedevents := app (filter (fun re => EventKind_beq (eventKind (eventDefinition re)) Exported) res) (exportedevents conf);*)
raisedevents :=  (filter (fun re => EventKind_beq (eventKind (eventDefinition re)) Internal) res) ;
exportedevents := (filter (fun re => EventKind_beq (eventKind (eventDefinition re)) Exported) res);
finishedscenarios := sce::nil;
sceEventMap := (sce,(eventDefinition re))::nil;

|})
end.

(*here we require existance of eventWhenExpr for the reason that multiple event_instances may correspond to this raised event.
We could add  guard expressions to each event. For one without when, we could add a true
*)
Fixpoint findEventInstance (re:raisedEvent) (en:value_env) (elist: list event_instance): option event_instance :=
match elist with
| nil => None
| e::lst' => let ex_env := createValueEnv (eventArgs e) (eventParams (eventDefinition re)) (eventArguments re) in
                 match ex_env with
                   | Result (env) => let extend_env := (extendValEnv (en) (env)) in
                                              match evalMonad extend_env (eventWhenExpr e) with
                                              | Result (inl (inr true)) =>Some e
                                              | Result (inl (inr false)) => findEventInstance re en lst'
                                              |_ => None
                                              end
                  | _ => None
                end
end.

Print object.

(*basic rule*)
Definition constructConfig (sce: scenario) (re: raisedEvent)  `(conf : configuration M) : ErrorOrResult:=
let sce_state := (getScenarioState sce (controlstate conf)) in
                     match sce_state with
                    | None =>  (Error error1)
                    | Some state =>
                       match (transEvMapFunc (stateEvDefInstanceMap M)  (Some state , Some (eventDefinition re))) with
                                 | None => Error error3
                                 | Some le =>
                               let e' :=  findEventInstance re (datastate conf) le in
                          match e' with
                          | None =>  Error error3
                          | Some e =>
                            let ex_env' := createValueEnv (eventArgs e) (eventParams (eventDefinition re)) (eventArguments re) in
                            match ex_env' with
                            |  (Error s) =>  (Error error12)
                            | Result (ex_env) =>
                            let extend_env := (extendValEnv (datastate conf) (ex_env) ) in
                               let stp:= (getStep' conf sce e) in match stp with
                                  | None =>  (Error error4)
                                  | Some stp' =>  match configTransition extend_env re e sce stp' conf with
                                                                | Error s => Error error11
                                                                | Result s => Result s
                                                 end
                                   end
                                  end
                             end
                     end
                   end
.

Print findEventInstance.

Fixpoint constructConfigList' (scs: list scenario) (re: raisedEvent) `(conf : configuration M): ErrorOrResult :=
match scs with
| nil => Result (nil)
| sce::scenarios' => match constructConfig sce re conf with
                                | Result conf' => match constructConfigList' scenarios' re conf with                                                         | Error s => Error s
                                                          | Result (lst) =>  Result ( conf' :: lst)
                                                          end
                                | Error s => Error (s)
                              end

end.

(*core method in synchrony rule, find all state machines that can be triggered by re and execute transitions*)
Definition constructConfigList (scs: list scenario) (re: raisedEvent) `(conf : configuration M): ErrorOrResult :=
let scs' := (filterList (finishedscenarios conf) scs scenario_dec) in
let scs'' :=  filter (fun x => inList (event_definition_dec) (eventDefinition re) (alphabet x)) scs' in
constructConfigList' scs'' re conf.

(*definition of an error configuration*)
Definition ErrConfig  (e: raisedEvent) `(conf: configuration M) :Prop:=
In e (raisedevents conf) -> (exists s, constructConfigList (dom (controlstate conf)) e conf = Error (s)).

(*no data state conflicts*)
Definition noDataConflict  (dso ds1 ds2:value_env): Prop :=
forall s, In s (dom (dso)) ->
(exists str, AIdent str = s) /\ ( (getValue s dso <> getValue s ds1) /\ (getValue s dso <> getValue s ds2) -> getValue s ds1 = getValue s ds2).

(*no control state conflicts*)
Definition noControlConflict (cso cs1 cs2 :scenario_env): Prop :=
forall s, getScenarioState s cso <> getScenarioState s cs1 -> getScenarioState s cso <> getScenarioState s cs2 -> getScenarioState s cs1 = getScenarioState s cs2.

(*no conflicts, used in the definition of synchrony rule*)
Definition noConflict {M : monitor} (originConf conf1 conf2: configuration M): Prop := noDataConflict (datastate originConf) (datastate conf1) (datastate conf2)
                /\ noControlConflict (controlstate originConf) (controlstate conf1) (controlstate conf2).

(*merge datastate*)
Fixpoint mergeDataStateFunc  (dso ds1 ds2:value_env) : ErrorOrResult :=
match dso, ds1, ds2 with
| (n1,(t1,v0))::lst0, (n2,(t2,v1))::lst1, (n3,(t3,v2))::lst2 => if atom_eq_dec n1 n2 then
                                                                                if atom_eq_dec n1 n3 then
                                                                                if typ_eq_dec t1 t2 then
                                                                                if typ_eq_dec t1 t3 then
                                              let r :=  mergeDataStateFunc lst0 lst1 lst2 in
                                                match r with
                                                | Error s => Error s
                                                | Result lst =>  if range_typ_dec v1 v2 then  Result ((n1,(t1,v1))::lst)
                                                                                else if ((range_typ_dec v1 v0)) then
                                                                                Result ((n1,(t1,v2))::lst)
                                                                                else if ((range_typ_dec v2 v0)) then
                                                                                Result ((n1,(t1,v1))::lst)
                                                                                else Error error13

                                               end
                                                else Error error5 else Error error5 else Error error5 else Error error5
| nil, nil, nil => Result nil
| _,_,_ => Error error6
end.

(*merge controlstate*)
Fixpoint mergeControlStateFunc  (cso cs1 cs2: scenario_env) : ErrorOrResult :=
match cso, cs1, cs2 with
| (sc0,s0)::lst0, (sc1,s1)::lst1, (sc2,s2)::lst2 => if scenario_dec sc0 sc1 then
                                                                                if scenario_dec sc0 sc2 then
                                              let r :=  mergeControlStateFunc lst0 lst1 lst2 in
                                                match r with
                                                | Error s => Error s
                                                | Result lst =>  if string_dec s1 s2 then  Result ((sc0,s1)::lst)
                                                                                else if ((string_dec s1 s0)) then
                                                                                Result ((sc0,s2)::lst)
                                                                                else  if ((string_dec s2 s0)) then Result ((sc0,s1)::lst)
                                                                                else Error error14

                                               end
                                                else Error error7 else Error error7
| nil, nil, nil => Result nil
| _,_,_ => Error error6
end.

(*merge configuration*)

Local Open Scope list_scope.

Definition mergeConfigFunc {M : monitor} (config config1 config2 : configuration M):  @ErrorOrResult (configuration M) :=
let ds:= mergeDataStateFunc (datastate config) (datastate config1) (datastate config2)
in match ds with
   | Error s => Error s
   | Result ds' =>
let cs:= mergeControlStateFunc (controlstate config) (controlstate config1) (controlstate config2)
in  match cs with
   | Error s => Error s
   | Result cs' =>
let raisedEvents := mergeList' (raisedevents config1) (raisedevents config2) (raisedEvent_dec) in
let exportedEvents := mergeList' (exportedevents config1) (exportedevents config2) (raisedEvent_dec) in
let finishedEvents := (finishedscenarios config1) ++ (finishedscenarios config2) ++ (finishedscenarios config) in
let sceEventMaps :=  (sceEventMap config1) ++ (sceEventMap config2) ++ (sceEventMap config) in
Result ({|
datastate := ds';
controlstate :=cs';
raisedevents := raisedEvents;
exportedevents := exportedEvents;
finishedscenarios := finishedEvents;
sceEventMap := sceEventMaps;
|})
end
end.

Definition mergeConfigFunc' {M : monitor} (config config1 config2 : configuration M) : @ErrorOrResult (configuration M) :=
let ds:= mergeDataStateFunc (datastate config) (datastate config1) (datastate config2)
in match ds with
   | Error s => Error s
   | Result ds' =>
let cs:= mergeControlStateFunc (controlstate config) (controlstate config1) (controlstate config2)
in  match cs with
   | Error s => Error s
   | Result cs' =>
(*let raisedEvents := mergeList' (raisedevents config1) (raisedevents config2) (raisedEvent_dec) in
let exportedEvents := mergeList' (exportedevents config1) (exportedevents config2) (raisedEvent_dec) in*)
let raisedEvents := app (raisedevents config1) (raisedevents config2) in
let exportedEvents := app (exportedevents config1) (exportedevents config2)  in
let finishedEvents := (finishedscenarios config1) ++ (finishedscenarios config2)  in
let sceEventMaps :=  (sceEventMap config1) ++ (sceEventMap config2)  in
Result ({|
datastate := ds';
controlstate :=cs';
raisedevents := raisedEvents;
exportedevents := exportedEvents;
finishedscenarios := finishedEvents;
sceEventMap := sceEventMaps;
|})
end
end.

Fixpoint innerCombineFunc'' {M : monitor} (lst: list (configuration M)) (o1: configuration M) (o2: configuration M) : option (configuration M) := match lst with
  | conf::lst' => let v := mergeConfigFunc' o1 o2 conf in
                  match v with
                  | Result conf' => innerCombineFunc'' lst' o1 conf'
                  | Error  s => None
                  end
  | _ => None
  end.

Fixpoint innerCombineFunc''' `(originconf: configuration M)  (confList: list (configuration M)): option (configuration M):=
  match confList with
  | conf' :: l =>  match innerCombineFunc''' originconf  l with
                    | Some c => match mergeConfigFunc' originconf c conf' with
                                 | Error s => None
                                 | Result rc => Some rc
                                end
                    | None => match mergeConfigFunc' originconf originconf conf' with
                              | Error s => None
                              | Result c => Some c
                              end
                   end
  | _ => None
  end.

Fixpoint innerCombineFunc'''' `(originconf: configuration M)  (confList: list (configuration M)) : option (configuration M) :=
  match confList with
  | conf' :: nil => match mergeConfigFunc' originconf originconf conf' with
                    | Error s => None
                    | Result c => Some c
                    end
  | conf' :: l => match innerCombineFunc'''' originconf  l with
                            | Some c =>  match  mergeConfigFunc' originconf conf' c with
                                          | Error s => None
                                          | Result rc => Some rc
                                         end
                            | None => None
                            end
  | _ => None
  end.

Print innerCombineFunc''''.

(*Fixpoint innerCombineFunc'''' `(originconf: configuration M)  (confList: list (configuration M)) : option (configuration M) :=
  match confList with
  | conf' :: nil => match mergeConfigFunc' originconf originconf conf' with
                    | Error s => None
                    | Result c => Some c
                    end
  | conf' :: conf'' :: l => match innerCombineFunc'''' originconf  l with
                            | Some c =>  match  mergeConfigFunc' originconf conf' conf'' with
                                          | Error s => None
                                          | Result rc => match mergeConfigFunc' originconf rc c with
                                                         | Error s => None
                                                         | Result c => Some c
                                                         end
                                         end
                            | None => None
                            end
  | _ => None
  end.
*)

Fixpoint innerCombineFunc' `(originconf: configuration M) (conf: option (configuration M)) (confList: list (configuration M)) : ErrorOrResult :=

match conf with
| None => match confList with
                 | nil => Error error9
                 | conf'::confList' => innerCombineFunc' originconf (Some conf') (confList')
                end
| Some conf' => match confList with
                 | nil => Result conf'
                 | conf''::confList' =>  let rconf := innerCombineFunc' originconf (Some conf'') ( (confList'))  in
                                                  match rconf with
                                                  | Error s => Error s
                                                  | Result rc => mergeConfigFunc originconf conf' rc
                                                  end
                end

end.

Definition removeEventFromConf (e:raisedEvent) `(conf:configuration M) : configuration M :=
   ({|
datastate := (datastate conf);
controlstate := (controlstate conf);
raisedevents := removeEvent' e ((raisedevents) conf);
exportedevents := (exportedevents conf);
finishedscenarios := (finishedscenarios conf);
sceEventMap := (sceEventMap conf);
|}).

Definition combineFunc  (e: raisedEvent) `(conf: configuration M): option (configuration M) :=

match constructConfigList (dom (controlstate conf)) e conf with
| (Error s) => None
| Result (lst) => match lst with
                         | nil => None
                         | lst' => match innerCombineFunc''''  conf lst' with
                                   | Some v => Some (removeEventFromConf e v)
                                   | None => None
                                   end
                        end
end
.

(*
(*merge datastate*)
Fixpoint mergeDataStateFunc  (dso ds1 ds2:value_env) : ErrorOrResult :=
match dso, ds1, ds2 with
| (n1,(t1,v0))::lst0, (n2,(t2,v1))::lst1, (n3,(t3,v2))::lst2 => if atom_eq_dec n1 n2 then
                                                                                if atom_eq_dec n1 n3 then
                                                                                if typ_eq_dec t1 t2 then
                                                                                if typ_eq_dec t1 t3 then
                                              let r :=  mergeDataStateFunc lst0 lst1 lst2 in
                                                match r with
                                                | Error s => Error s
                                                | Result lst =>  if range_typ_dec v1 v2 then  Result ((n1,(t1,v1))::lst)
                                                                                else if ((range_typ_dec v1 v0)) then
                                                                                Result ((n1,(t1,v2))::lst)
                                                                                else if ((range_typ_dec v2 v0)) then
                                                                                Result ((n1,(t1,v1))::lst)
                                                                                else Error error13

                                               end
                                                else Error error5 else Error error5 else Error error5 else Error error5
| nil, nil, nil => Result nil
| _,_,_ => Error error6
end.

(*merge controlstate*)
Fixpoint mergeControlStateFunc  (cso cs1 cs2: scenario_env) : ErrorOrResult :=
match cso, cs1, cs2 with
| (sc0,s0)::lst0, (sc1,s1)::lst1, (sc2,s2)::lst2 => if scenario_dec sc0 sc1 then
                                                                                if scenario_dec sc0 sc2 then
                                              let r :=  mergeControlStateFunc lst0 lst1 lst2 in
                                                match r with
                                                | Error s => Error s
                                                | Result lst =>  if string_dec s1 s2 then  Result ((sc0,s1)::lst)
                                                                                else if ((string_dec s1 s0)) then
                                                                                Result ((sc0,s2)::lst)
                                                                                else  if ((string_dec s2 s0)) then Result ((sc0,s1)::lst)
                                                                                else Error error14

                                               end
                                                else Error error7 else Error error7
| nil, nil, nil => Result nil
| _,_,_ => Error error6
end.

(*merge configuration*)
Definition mergeConfigFunc (config config1 config2 : configuration):  ErrorOrResult:=
let ds:= mergeDataStateFunc (datastate config) (datastate config1) (datastate config2)
in match ds with
   | Error s => Error s
   | Result ds' =>
let cs:= mergeControlStateFunc (controlstate config) (controlstate config1) (controlstate config2)
in  match cs with
   | Error s => Error s
   | Result cs' =>
let raisedEvents := mergeList' (raisedevents config1) (raisedevents config2) (raisedEvent_dec) in
let exportedEvents := mergeList' (exportedevents config1) (exportedevents config2) (raisedEvent_dec) in
let finishedEvents := mergeList' (finishedscenarios config1) (finishedscenarios config2) (scenario_dec) in
Result ({|
monitor_obj := (monitor_obj config);
datastate := ds';
controlstate :=cs';
raisedevents := raisedEvents;
exportedevents := exportedEvents;
finishedscenarios := finishedEvents;

|})
end
end.

Fixpoint innerCombineFunc' (originconf: configuration) (conf: option configuration) (confList: (list configuration)): ErrorOrResult:=

match conf with
| None => match confList with
                 | nil => Error error8
                 | conf'::confList' => innerCombineFunc' originconf (Some conf') (confList')
                end
| Some conf' => match confList with
                 | nil => Result conf'
                 | conf''::confList' =>  let rconf := innerCombineFunc' originconf (Some conf'') ( (confList'))  in
                                                  match rconf with
                                                  | Error s => Error s
                                                  | Result rc => mergeConfigFunc originconf conf' rc
                                                  end
                end

end.

Definition combineFunc  (e: raisedEvent) (conf: configuration): ErrorOrResult :=

match constructConfigList (dom (controlstate conf)) e conf with
| (Error s) => Error s
| Result (lst) => match lst with
                         | nil => Error error9
                         | lst' =>  innerCombineFunc' conf None lst'
                        end
end
.

*)

Definition conflict (e: raisedEvent) `(conf: configuration M) :Prop:=
(exists clist, (constructConfigList (dom (controlstate conf)) e conf =
Result (clist)) /\ exists conf1 conf2, In conf1 clist /\ In conf2 clist /\ ~(noConflict conf conf1 conf2)).

(*combine configurations having same source configuration and same triggering event*)
Definition synchrony {M : monitor} (conf conf' :configuration M) (event:raisedEvent) : Prop :=
In event (raisedevents conf) /\ combineFunc event conf = Some (conf').

(*
Definition synchrony  (conf conf' :configuration) (event:raisedEvent) : Prop :=
In event (raisedevents conf) /\ ~(ErrConfig event conf ) /\  ~(conflict event conf) /\ combineFunc event conf = Result (conf').
 *)

(*initial configuration*)
Definition readyConfig  `(conf :configuration M) : Prop :=
correct_configuration conf /\ raisedevents conf = nil
/\ (exportedevents conf) = nil
/\ (finishedscenarios conf) = nil
/\ (sceEventMap conf) = nil.

(*initial configuration*)
Definition initialConfig  `(conf :configuration M) : Prop :=
correct_configuration conf /\ (length (raisedevents conf) = S O)
/\ (forall e,  In e (raisedevents conf) -> importedEvent (eventDefinition e)
/\ (exists sce, In sce (dom (controlstate conf))
/\ In (eventDefinition e) ((alphabet) sce)))
/\ (finishedscenarios conf) = nil
/\ (sceEventMap conf) = nil.

Print configuration.

Definition configStEq {M : monitor} (conf conf': configuration M) : Prop :=
  datastate conf = datastate conf' /\
  controlstate conf = controlstate conf'.

Definition configTrans {M : monitor} (conf conf': configuration M) : Prop :=
 readyConfig conf /\ initialConfig conf' /\ configStEq conf conf'.

Definition configTransRev {M : monitor} (conf conf': configuration M) : Prop :=
 configStEq conf conf' /\ readyConfig conf'.

(*chain merge rule*)
Inductive chainMerge (M : monitor) : configuration M -> configuration M-> raisedEvent ->  Prop :=
| basic': forall conf conf' event, initialConfig conf ->  synchrony conf conf' event -> chainMerge conf conf' event
| chain': forall conf conf'' conf' event1 event2, chainMerge conf conf' event1 -> synchrony conf' conf'' event2-> chainMerge conf conf'' event1.

Inductive chainMergeStep (M : monitor) : configuration M -> configuration M-> raisedEvent -> nat -> Prop :=
| merge_basic: forall conf conf' event, (importedEvent (eventDefinition event)) ->  synchrony conf conf' event -> chainMergeStep conf conf' event O
| merge_chain: forall conf conf'' conf' event1 event2 n, chainMergeStep conf conf' event1 n -> synchrony conf' conf'' event2-> chainMergeStep conf conf'' event1 (S n).

(* transEvMap ((getScenarioState sce (controlstate conf)), Some (eventDefinition e))  = nil)
means that e is not in the alphabet of sce
SMEDL asks for the complete scenario, so if e is in the alphabet of
sce, then transEvMap should always return a value
 *)

(*
Definition finalConfig (conf:configuration):Prop:=
correct_configuration conf /\ ((length (raisedevents conf) = O)  \/ (forall e  , In e (raisedevents conf) -> (~importedOrInternalEvent (eventDefinition e)
/\  (forall sce, In sce (dom (controlstate conf)) /\ ~ (In sce (finishedscenarios conf)) -> transEvMap ((getScenarioState sce (controlstate conf)), Some (eventDefinition e))  = nil)))).
 *)

Definition finalConfig `(conf:configuration M):Prop:=
(length (raisedevents conf) = O)  \/  incl (dom (controlstate conf)) (finishedscenarios conf).

Definition chainMergeTrans {M : monitor} (conf conf' econf: configuration M) (e: raisedEvent) (rconf: configuration M)  (events: list raisedEvent)  : Prop :=
   configTrans conf conf' /\ chainMerge conf' econf e /\ finalConfig econf /\ configTransRev econf rconf /\ events = exportedevents econf.

(*definition of stuck configuration*)
Definition stuckConfig `(conf:configuration M):Prop:=
  (forall e , In e (raisedevents conf) -> (~(exists conf', synchrony conf conf' e))).

(*equivlance relation between two configurations*)
Definition equivConf {M : monitor} (conf conf':configuration M) : Prop :=
(datastate conf) = (datastate conf') /\ (controlstate conf) = (controlstate conf')
/\ incl (raisedevents conf) (raisedevents conf') /\ incl (raisedevents conf') (raisedevents conf) /\ Permutation (finishedscenarios conf) (finishedscenarios conf')
/\ incl (exportedevents conf) (exportedevents conf') /\ incl (exportedevents conf') (exportedevents conf) /\ Permutation (sceEventMap conf) (sceEventMap conf').

(*equivConf is an equivalence relation*)
Lemma equivConf_Refl {M : monitor} : forall x : configuration M,
equivConf x x.
Proof. intros. unfold equivConf;split;auto. repeat(try (split;auto)).
       unfold incl;intros;auto.
       unfold incl;intros;auto.

       unfold incl;intros;auto.
       unfold incl;intros;auto.

Qed.

Lemma equivConf_Sym {M : monitor} : forall x1 x2 : configuration M,
equivConf x1 x2 <-> equivConf x2 x1.
Proof. intros. split.
- intros. unfold equivConf in H.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
unfold equivConf. repeat(split;auto);repeat(apply Permutation_sym; auto).

- intros. unfold equivConf in H.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

           end.
    unfold equivConf. repeat(split;auto);repeat(apply Permutation_sym; auto).
Qed.

Lemma equivConf_Trans {M : monitor} : forall x1 x2 x3 : configuration M,
equivConf x1 x2 -> equivConf x2 x3 -> equivConf x1 x3.
Proof. intros. unfold equivConf in H. unfold equivConf in H0.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
    unfold equivConf. split;auto. rewrite H;auto.  split. rewrite <- H1;auto.
    split.
unfold incl in *. intros. apply H2. apply H9;auto.
split.
unfold incl in *. intros. apply H10. apply H3;auto.

split.

eapply Permutation_trans. apply H11. auto.
split.

unfold incl in *. intros. apply H5. apply H12;auto.
split.
unfold incl in *. intros. apply H13. apply H6;auto.
eapply Permutation_trans. apply H14. auto.
Qed.

(*(*equivlance relation between two configurations*)
Definition equivConf {M : monitor} (conf conf':configuration M) : Prop :=
(datastate conf) = (datastate conf') /\ (controlstate conf) = (controlstate conf')
/\ Permutation (raisedevents conf) (raisedevents conf') /\ Permutation (finishedscenarios conf) (finishedscenarios conf')
/\ incl (exportedevents conf) (exportedevents conf') /\ incl (exportedevents conf') (exportedevents conf) /\ Permutation (sceEventMap conf) (sceEventMap conf').

(*equivConf is an equivalence relation*)
Lemma equivConf_Refl {M : monitor} : forall x : configuration M,
equivConf x x.
Proof. intros. unfold equivConf;split;auto. repeat(try (split;auto)).
       unfold incl;intros;auto.
        unfold incl;intros;auto.
Qed.

Lemma equivConf_Sym {M : monitor} : forall x1 x2 : configuration M,
equivConf x1 x2 <-> equivConf x2 x1.
Proof. intros. split.
- intros. unfold equivConf in H.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
unfold equivConf. repeat(split;auto);repeat(apply Permutation_sym; auto).

- intros. unfold equivConf in H.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

           end.
    unfold equivConf. repeat(split;auto);repeat(apply Permutation_sym; auto).
Qed.

Lemma equivConf_Trans {M : monitor} : forall x1 x2 x3 : configuration M,
equivConf x1 x2 -> equivConf x2 x3 -> equivConf x1 x3.
Proof. intros. unfold equivConf in H. unfold equivConf in H0.
    repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
    unfold equivConf. split;auto. rewrite H;auto.  split. rewrite <- H1;auto.
split.
eapply Permutation_trans. apply H8. auto.
split.
eapply Permutation_trans. apply H9. auto.
split.
unfold incl in *. intros. apply H4. apply H10;auto.
split.
unfold incl in *. intros. apply H11. apply H10;auto.
eapply Permutation_trans. apply H12. auto.
Qed.*)

End semantic_rule.

(*Fixpoint eventInPath (ev:event_definition) (lst: list event_definition): bool :=
match lst with
| nil => false
| ev'::lst' => if event_definition_dec ev ev' then true else eventInPath ev lst'
end.

Fixpoint checkUpdateValue' (a:atom) (lst: list updatedVariable) (re:raisedEvent) : bool :=
match lst with
| nil => true
| v::lst' => if (atom_eq_dec a (up_var v)) then eventInPath (eventTag v) (pathEvents re) else checkUpdateValue' a lst' re
end.

Fixpoint checkUsedValue'' (evList:list event_definition) (pathList: list event_definition) : bool :=
match evList with
| nil => true
| ev::lst' => if eventInPath ev pathList then checkUsedValue'' lst' pathList else false
end.

Fixpoint checkUsedValue' (a:atom) (lst: list usedVariable) (re:raisedEvent) : bool :=
match lst with
| nil => true
| v::lst' => if (atom_eq_dec a (used_var v)) then checkUsedValue'' (used_eventTagList v) (pathEvents re) else checkUsedValue' a lst' re
end.

Print configuration.

Fixpoint checkValue (conf:configuration) (re:raisedEvent) (lst: list atom)   : bool :=
match lst with
| nil => true
| a::lst' => if checkUpdateValue' a (updatedvariableList conf) re then checkValue conf re lst' else  false
end.

Fixpoint checkUpdatedUsedValue (conf:configuration) (re:raisedEvent) (lst: list atom) : bool :=
match lst with
| nil => true
| a::lst' => if checkUsedValue' a (usedvariableList conf) re then checkUpdatedUsedValue conf re lst' else  false
end.

Definition checkValueNonDeterminism (conf:configuration) (re:raisedEvent)  (stp:step) :bool :=
let usedVariables :=  getUsedVariablesFromScenario conf stp in
let updatedVariables := getUpdatedVariablesFromScenario conf stp in
checkValue conf re usedVariables &&
checkValue conf re updatedVariables &&
checkUpdatedUsedValue conf re updatedVariables
.

Fixpoint updateUsedVariables' (lst: list usedVariable) (a: atom) (re:raisedEvent) : option usedVariable
:=
match lst with
| nil => None
| uv::lst' => if atom_eq_dec a (used_var uv) then
   Some {|used_var := (used_var uv); used_eventTagList:= ( eventDefinition re) :: (used_eventTagList uv) |}
else updateUsedVariables' lst' a re
end.

Fixpoint updateUsedVariables (lst: list usedVariable) (lstAtom: list atom) (re:raisedEvent)
:  list usedVariable :=
match lstAtom with
| nil => lst
| a::lstAtom' => match  (updateUsedVariables' lst a re) with
                        | None => (updateUsedVariables lst lstAtom' re)
                        | Some uv => uv :: (updateUsedVariables lst lstAtom' re)
                       end
end.

Fixpoint updatedVariable' (lst: list updatedVariable) (a: atom) (re:raisedEvent) : option updatedVariable
:=
match lst with
| nil => None
| uv::lst' => if atom_eq_dec a (up_var uv) then
   Some {|up_var := (up_var uv); eventTag:= ( eventDefinition re) |}
else updatedVariable' lst' a re
end.

Fixpoint updateUpdateVariables (lst: list updatedVariable) (lstAtom: list atom) (re:raisedEvent)
:  list updatedVariable :=
match lstAtom with
| nil => lst
| a::lstAtom' => match  (updatedVariable' lst a re) with
                        | None => (updateUpdateVariables lst lstAtom' re)
                        | Some uv => uv :: (updateUpdateVariables lst lstAtom' re)
                       end
end.

Fixpoint newUpdateVariables (lstAtom : list atom) (re:raisedEvent): list updatedVariable :=
match lstAtom with
| nil => nil
| a::lstAtom' => {|up_var := a; eventTag := eventDefinition re |} :: newUpdateVariables lstAtom' re
end.

Fixpoint newUsedVariables (lstAtom : list atom) (re:raisedEvent): list usedVariable :=
match lstAtom with
| nil => nil
| a::lstAtom' => {|used_var := a; used_eventTagList := (eventDefinition re)::nil |} :: newUsedVariables lstAtom' re
end.*)


(* Lemmas about memory *)
Require Import Util.
Require Import block_model.
Require Import conc_model.
Require Import Lang.

Set Implicit Arguments.

Notation indep ops1 ops2 := (Forall (fun c1 => Forall (fun c2 =>
  loc_of c2 <> loc_of c1) ops2) ops1).

Section SC.

Context {ML : @Memory_Layout var nat _}.

Global Instance conc_op_dec : EqDec_eq conc_op.
Proof. eq_dec_inst. Qed.

Definition consistent (m : list conc_op) := @SC _ _ _ ML _ _ Base m.

Definition can_read (m : list conc_op) p v := consistent (m ++ [Read 0 p v]).
Definition can_write (m : list conc_op) p :=
  forall v, consistent (m ++ [Write 0 p v]).

Definition prog_op c := match c with Read _ _ _ | Write _ _ _ | ARW _ _ _ _ =>
  True | _ => False end.

Lemma op_indep : forall c1 c2 (Hindep : loc_of c1 <> loc_of c2)
   (Hc1 : prog_op c1) (Hc2 : prog_op c2),
   Forall (fun l => Forall (independent l) (map block_model.loc_of (to_seq c2)))
     (map block_model.loc_of (to_seq c1)).
Proof.
  destruct c1, c2; clarify.
Qed.

Lemma loc_comm_SC : forall m1 c1 c2 m2 (Hindep : loc_of c1 <> loc_of c2)
  (Hc1 : prog_op c1) (Hc2 : prog_op c2)
  (Hcon : consistent (m1 ++ c1 :: c2 :: m2)), consistent (m1 ++ c2 :: c1 :: m2).
Proof.
  unfold consistent, SC; clarify.
  rewrite lower_app, lower_cons, lower_cons;
    rewrite lower_app, lower_cons, lower_cons in Hcon.
  repeat rewrite to_ilist_app in *; rewrite loc_comm_ops; auto.
  apply op_indep; auto.
Qed.

Lemma loc_comm_ops1_SC : forall c lc m1 m2
  (Hindep : Forall (fun c' => loc_of c' <> loc_of c) lc)
  (Hc : prog_op c) (Hlc : Forall prog_op lc),
  consistent (m1 ++ c :: lc ++ m2) <-> consistent (m1 ++ lc ++ c :: m2).
Proof.
  induction lc; clarify; [reflexivity|].
  inversion Hlc; inversion Hindep; clarify.
  specialize (IHlc (m1 ++ [a]) m2); clarsimp.
  etransitivity; eauto; split; apply loc_comm_SC; auto.
Qed.

Lemma loc_comm_ops_SC : forall lc1 lc2 m1 m2
  (Hindep : Forall (fun c => Forall (fun c' => loc_of c' <> loc_of c) lc2) lc1)
  (Hlc1 : Forall prog_op lc1) (Hlc2 : Forall prog_op lc2),
  consistent (m1 ++ lc1 ++ lc2 ++ m2) <-> consistent (m1 ++ lc2 ++ lc1 ++ m2).
Proof.
  induction lc1; clarify; [reflexivity|].
  inversion Hlc1; clarify.
  specialize (IHlc1 lc2 (m1 ++ [a]) m2); inversion Hindep; clarsimp.
  etransitivity; eauto; apply loc_comm_ops1_SC; auto.
Qed.

Lemma consistent_app_SC : forall m1 m2 (Hcon : consistent (m1 ++ m2)),
  consistent m1.
Proof.
  unfold consistent, SC; intros.
  rewrite lower_app in Hcon; eapply consistent_app; eauto.
Qed.

Lemma consistent_drop : forall m c1 c2, consistent (m ++ [c1; c2]) ->
  consistent (m ++ [c1]).
Proof.
  intros; eapply consistent_app_SC; rewrite <- app_assoc; simpl; eauto.
Qed.

Lemma loc_valid_SC : forall m c1 c2 (Hindep : loc_of c1 <> loc_of c2)
  (Hc1 : prog_op c1) (Hc2 : prog_op c2),
  consistent (m ++ [c1; c2]) <->
  (consistent (m ++ [c1]) /\ consistent (m ++ [c2])).
Proof.
  split; intros.
  - split.
    + rewrite split_app in H; exploit consistent_app_SC; eauto; clarify.
    + exploit loc_comm_SC; eauto; intro H'.
      rewrite split_app in H'; exploit consistent_app_SC; eauto; clarify.
  - unfold consistent, SC in *; clarify.
    repeat rewrite lower_app; rewrite lower_cons; repeat rewrite lower_single.
    rewrite lower_app, lower_single in H1, H2.
    apply loc_valid_ops; auto.
    apply op_indep; auto.
Qed.

Lemma loc_valid_ops1_SC : forall c lc m
  (Hindep : Forall (fun c' => loc_of c' <> loc_of c) lc)
  (Hc : prog_op c) (Hlc : Forall prog_op lc),
  consistent (m ++ lc ++ [c]) <->
  (consistent (m ++ lc) /\ consistent (m ++ [c])).
Proof.
  induction lc; clarify.
  { split; clarsimp.
    eapply consistent_app_SC; eauto. }
  inversion Hlc; clarify.
  specialize (IHlc (m ++ [a])); inversion Hindep; clarsimp.
  rewrite IHlc, loc_valid_SC; auto.
  split; intro Hcon; clarify.
  rewrite split_app in Hcon1; eapply consistent_app_SC; eauto.
Qed.

Corollary loc_valid_ops2_SC : forall m c lc
  (Hindep : Forall (fun c' => loc_of c' <> loc_of c) lc)
  (Hc : prog_op c) (Hlc : Forall prog_op lc),
  consistent (m ++ c :: lc) <->
  (consistent (m ++ lc) /\ consistent (m ++ [c])).
Proof.
  intros; rewrite <- loc_valid_ops1_SC; auto.
  generalize (loc_comm_ops1_SC _ m [] Hindep); rewrite app_nil_r; auto.
Qed.

Lemma loc_valid_ops_SC : forall lc1 lc2 m
  (Hindep : Forall (fun c => Forall (fun c' => loc_of c' <> loc_of c) lc2) lc1)
  (Hlc1 : Forall prog_op lc1) (Hlc2 : Forall prog_op lc2),
  consistent (m ++ lc1 ++ lc2) <->
  (consistent (m ++ lc1) /\ consistent (m ++ lc2)).
Proof.
  induction lc1; clarify.
  { split; clarsimp.
    eapply consistent_app_SC; eauto. }
  inversion Hlc1; clarify.
  specialize (IHlc1 lc2 (m ++ [a])); inversion Hindep; clarsimp.
  rewrite IHlc1; setoid_rewrite loc_valid_ops2_SC at 2; auto.
  split; intro Hcon; clarify.
  rewrite split_app in Hcon1; eapply consistent_app_SC; eauto.
Qed.

Lemma read_noop_SC : forall m t x v m2 (Hcon : consistent (m ++ [Read t x v])),
  consistent (m ++ Read t x v :: m2) <-> consistent (m ++ m2).
Proof.
  unfold consistent, SC; clarify.
  repeat rewrite lower_app; rewrite lower_app in Hcon.
  rewrite lower_single in Hcon; rewrite lower_cons; clarify.
  rewrite split_app; do 2 rewrite to_ilist_app; apply read_noop; auto.
Qed.

Corollary reads_noops_SC : forall ops m m2
  (Hcon : consistent (m ++ ops))
  (Hread : Forall (fun c => match c with Read _ _ _ => True | _ => False end)
                  ops),
  consistent (m ++ ops ++ m2) <-> consistent (m ++ m2).
Proof.
  induction ops; clarify; [reflexivity|].
  specialize (IHops (m ++ [a]) m2); inversion Hread; clarsimp.
  destruct a; clarify.
  rewrite IHops; apply read_noop_SC.
  rewrite split_app in Hcon; eapply consistent_app_SC; eauto.
Qed.

Lemma can_read_thread : forall m p v t, can_read m p v ->
  consistent (m ++ [Read t p v]).
Proof.
  unfold can_read, consistent, SC; setoid_rewrite lower_app; clarify.
Qed.

Lemma can_write_thread : forall m p v t, can_write m p ->
  consistent (m ++ [Write t p v]).
Proof.
  unfold can_write, consistent, SC; setoid_rewrite lower_app; clarify.
  specialize (H v); clarify.
Qed.

Lemma can_write_SC : forall p ops m (Hcan : can_write m p)
  (Hcon : consistent (m ++ ops)) (Hops : Forall prog_op ops),
  can_write (m ++ ops) p.
Proof.
  induction ops; clarsimp.
  inversion Hops; clarify.
  specialize (IHops (m ++ [a])); clarsimp.
  apply IHops; auto; clear IHops.
  rewrite split_app in Hcon; exploit consistent_app_SC; eauto; intro Hcon'.
  clear Hcon; unfold can_write, consistent, SC in *; clarsimp.
  specialize (Hcan v); rewrite lower_app, lower_single in Hcan, Hcon';
    rewrite lower_app, lower_cons, lower_single.
  destruct a; clarify.
  - rewrite read_noop_single; auto.
  - rewrite write_not_read_single; clarify.
  - rewrite split_app, write_not_read_single; clarsimp.
    rewrite read_noop_single; auto.
    rewrite split_app in Hcon'; eapply consistent_app; eauto.
Qed.

Lemma can_read_SC: forall p ops m v (Hcan: can_read m p v)
 (Hcon: consistent (m ++ ops)) (Hops : Forall prog_op ops)
  (Hnmods: Forall (fun c => match c with | Write _ x _ => p <> x
     | ARW _ x _ _=> p <> x | _ => True end) ops),
 can_read (m++ops) p v.
Proof.
 induction ops; clarsimp.
 inversion Hops; clarify.
 specialize(IHops (m++[a])); clarsimp.
 apply IHops; auto.
 rewrite split_app in Hcon; exploit consistent_app_SC; eauto; intro Hcon'.
 unfold can_read, consistent, SC in *; clarsimp.
rewrite lower_app, lower_single in Hcon'.
 rewrite lower_app, lower_single in Hcan.
 rewrite lower_app, lower_cons, lower_single.

 destruct a; clarify.
 -rewrite read_noop_single; clarify; auto.
 -rewrite write_not_read_single; auto.
  intros.
  apply Forall_inv in Hnmods. clarsimp.
  intro Heq. inversion Heq; clarify.
 -rewrite split_app. rewrite write_not_read_single; clarsimp.
  +rewrite read_noop_single; auto.
   rewrite split_app in Hcon'; eapply consistent_app; eauto.
  +apply Forall_inv in Hnmods. clarsimp.
   intro Heq. inversion Heq; clarify.
 -assert( a::ops =[a]++ops) as Haops.
    clarify.
  rewrite Haops in Hnmods.
  apply Forall_app in Hnmods. inversion Hnmods. auto.
Qed.

Lemma can_arw_SC_iff: forall p m v v' t,
  consistent (m ++ [ARW t p v v']) <-> can_write (m ++ [Read t p v]) p.
Proof.
  unfold can_write, consistent, SC.
  repeat setoid_rewrite lower_app. setoid_rewrite lower_single. clarify. unfold seq_con.
  rewrite split_app.
  split; clarify.
  rewrite write_any_value.
  eauto.
Qed.

Lemma can_arw_SC : forall p m v (Hcan_r : can_read m p v)
  (Hcan_w: can_write m p) t v', consistent (m ++ [ARW t p v v']).
Proof.
  intros.
  rewrite can_arw_SC_iff.
  apply can_write_SC; auto.
  apply can_read_thread.
  auto.
  { constructor; clarify. }
Qed.

Lemma write_any_value_SC : forall m t p v v',
  consistent (m ++ [Write t p v]) <-> consistent (m ++ [Write t p v']).
Proof.
  intros; unfold consistent, SC; setoid_rewrite lower_app.
  repeat rewrite lower_single; simpl; apply write_any_value.
Qed.

Lemma can_read_SC': forall p ops m v (Hcan: can_read m p v)
  (Hcon: consistent (m ++ ops)) (Hops : Forall prog_op ops)
  (Hnmods: Forall (fun c => match c with | Write _ x _ => p <> x
     | ARW _ x _ _=> p <> x | _ => True end) ops),
 can_read (m ++ ops) p v.
Proof.
 induction ops; clarsimp.
 inversion Hops; clarify.
 specialize(IHops (m++[a])); clarsimp.
 apply IHops; auto.
 rewrite split_app in Hcon; exploit consistent_app_SC; eauto; intro Hcon'.
 unfold can_read, consistent, SC in *; clarsimp.
rewrite lower_app, lower_single in Hcon'.
 rewrite lower_app, lower_single in Hcan.
 rewrite lower_app, lower_cons, lower_single.

 destruct a; clarify.
 -rewrite read_noop_single; clarify; auto.
 -rewrite write_not_read_single; auto.
  intros.
  apply Forall_inv in Hnmods. clarsimp.
  intro Heq. inversion Heq; clarify.
 -rewrite split_app. rewrite write_not_read_single; clarsimp.
  +rewrite read_noop_single; auto.
   rewrite split_app in Hcon'; eapply consistent_app; eauto.
  +apply Forall_inv in Hnmods. clarsimp.
   intro Heq. inversion Heq; clarify.
 -assert( a::ops =[a]++ops) as Haops.
    clarify.
  rewrite Haops in Hnmods.
  apply Forall_app in Hnmods. inversion Hnmods. auto.
Qed.

Lemma read_arwritten_SC : forall m p u v v' t (Hcon : consistent (m ++ [ARW t p u v])),
      consistent ((m ++ [ARW t p u v] )++ [Read t p v']) <-> v' = v.
Proof.
  intros.
  unfold consistent, SC in *; clarify.
  repeat rewrite lower_app in Hcon. rewrite lower_single in Hcon. clarify.
  repeat rewrite lower_app,lower_single in *; clarify.
  rewrite <- app_assoc; simpl.
  rewrite split_app in *.
  apply read_written. auto.
Qed.

Lemma can_read_thread' : forall m p v t,   consistent (m ++ [Read t p v]) ->
     can_read m p v .
Proof.
  unfold can_read, consistent, SC; setoid_rewrite lower_app; clarify.
Qed.

Lemma write_any_SC: forall t v m p
 (Hcon: consistent (m++[Write t p v ])),  can_write m p.
Proof.
  intros.
  unfold can_write, consistent, SC in *.  intros. rewrite lower_app in *.
  rewrite lower_app in Hcon. rewrite lower_single in *. rewrite lower_single in Hcon.
  simpl. simpl in Hcon. rewrite write_any_value. eauto.
Qed.

Definition initialized m p :=
  exists v, last_op (lower(MM_base := Base) m) (Ptr p) (MWrite p v).

Definition in_range_dec i a b : {a <= i < b} + {~a <= i < b}.
Proof.
  destruct (le_dec a i); [|right; omega].
  destruct (lt_dec i b); [left; auto | right; omega].
Qed.

Lemma loc_split : forall t lc m1 m2 m3
  (Hcon : consistent (m1 ++ lc ++ m2 ++ m3))
  lct lcr (Hpart : partition (fun c => beq (thread_of c) t) lc = (lct, lcr))
  (Hindep : Forall (fun c => Forall (fun c' => loc_of c' <> loc_of c) m2 /\
     Forall (fun c' => loc_of c' <> loc_of c) lct) lcr)
  (Hlc : Forall prog_op lc) (Hm2 : Forall prog_op m2),
  consistent (m1 ++ lct ++ m2 ++ lcr ++ m3).
Proof.
  setoid_rewrite partition_filter.
  induction lc using rev_ind; clarify.
  repeat rewrite filter_app in *; clarify.
  rewrite Forall_app in *; clarify.
  inversion Hlc2; clear Hlc2; subst.
  destruct (beq (thread_of x) t) eqn: Ht; unfold beq in Ht; clarify.
  - specialize (IHlc m1 (x :: m2) m3); clarsimp.
    apply IHlc; auto.
    rewrite Forall_forall in *; intros ? Hin.
    specialize (Hindep1 _ Hin); rewrite Forall_app in *; clarify.
    inversion Hindep122; clarify.
  - inversion Hindep2; specialize (IHlc m1 m2 (x :: m3)); clarsimp.
    apply IHlc; auto.
    rewrite app_assoc, loc_comm_ops1_SC, <- app_assoc in H; auto.
Qed.

Lemma last_write : forall (m : list conc_op) p v,
  last_op (@lower _ _ _ _ _ Base m) (Ptr p) (MWrite p v) <->
  exists c, find (fun c => writesb c p) (rev m) = Some c /\
  write_val c = Some v.
Proof.
  induction m using rev_ind; clarify.
  { split; clarify.
    apply last_nil in H; contradiction. }
  rewrite rev_app_distr, lower_app, lower_single, last_op_app; simpl.
  destruct (writesb x p) eqn: Hx.
  - split; clarify.
    + do 2 eexists; eauto.
      destruct H; clarify.
      * destruct x; clarify; try rewrite last_single in H; clarify.
        { inversion H1; clarify. }
        { destruct H as (i & ? & Hi); destruct i; clarify.
          destruct i; clarify; rewrite inth_nil in Hi; inversion Hi. }
      * destruct x; clarify; unfold beq in *; inversion H2; clarsimp.
        { inversion H4; clarify. }
        { destruct p; clarify. }
        { destruct p; clarify. }
    + left; destruct x0; clarify; unfold beq in *; clarify.
      * rewrite last_single; clarify.
      * exists 1; clarify.
        econstructor; simpl; eauto; intros.
        destruct j; clarify.
        destruct j; clarify.
        rewrite inth_nil in H; inversion H.
  - etransitivity; eauto.
    split; clarify.
    + destruct x; clarify; unfold beq in *; clarify;
        try (rewrite last_single in H; clarify).
      destruct H as (i & ? & Hi); destruct i; clarify.
      destruct i; clarify; rewrite inth_nil in Hi; inversion Hi.
    + right; clarify.
      destruct x; clarify; unfold beq in *; constructor; clarify.
Qed.

Lemma init_read : forall m p (Hinit : initialized m p) (Hcon : consistent m) v,
  can_read m p v <-> exists c,
    find (fun c => writesb c p) (rev m) = Some c /\ write_val c = Some v.
Proof.
  unfold can_read; intros.
  destruct Hinit as (v' & Hlast).
  unfold consistent, SC; rewrite lower_app, lower_single; simpl.
  rewrite read_last; eauto.
  rewrite last_write in Hlast; clarify.
  split; clarsimp; eauto.
Qed.

Lemma can_read_unique : forall m p v v'
  (Hinit : initialized m p) (Hv : can_read m p v) (Hv' : can_read m p v'),
  v' = v.
Proof.
  unfold can_read; intros.
  exploit consistent_app_SC; eauto; intro.
  unfold consistent, SC, lower in *.
  rewrite map_app, flatten_app in *; clarify.
  destruct Hinit.
  rewrite read_last in Hv, Hv'; eauto; clarify.
Qed.

Lemma init_step : forall m p a (Hinit : initialized m p) (Hprog : prog_op a),
  initialized (m ++ [a]) p.
Proof.
  unfold initialized; clarify.
  rewrite lower_app, lower_single; destruct a; clarify.
  - exists x; rewrite last_op_app; right; clarify.
  - destruct (eq_dec x0 p).
    + subst; exists v; rewrite last_op_app; left.
      setoid_rewrite last_single; clarify.
    + exists x; rewrite last_op_app; right; clarify.
  - destruct (eq_dec x0 p).
    + subst; exists v'; rewrite last_op_app; left.
      exists 1; clarify.
      econstructor; simpl; eauto.
      destruct j; clarify.
      destruct j; clarsimp.
    + exists x; rewrite last_op_app; right; clarify.
Qed.

Lemma init_steps : forall m p s (Hinit : initialized m p) (Hprog : Forall prog_op s),
  initialized (m ++ s) p.
Proof.
  intros. generalize dependent m. induction s.
  -intros. rewrite app_nil_r. auto.
  -intros. rewrite split_app. apply IHs.
   +rewrite Forall_forall in *. intros. clarify.
   +apply init_step; auto.
    eapply Forall_inv. eauto.
Qed.

Lemma ARW_can_read : forall p m v v' t, consistent (m ++ [ARW t p v v']) ->
  can_read m p v.
Proof.
  intros; rewrite can_arw_SC_iff in H; specialize (H 0).
  exploit consistent_app_SC; eauto; intro.
  eapply can_read_thread'; eauto.
Qed.

Lemma can_read_arwritten : forall m p u v t, consistent (m ++ [ARW t p u v]) ->
  can_read (m ++ [ARW t p u v]) p v.
Proof.
  intros.
  apply (can_read_thread' _ _ _ t).
  rewrite read_arwritten_SC; auto.
Qed.

Definition mem_ext m1 m2 := (forall ops, consistent (m1 ++ ops) <->
  consistent (m2 ++ ops)) /\ forall p, initialized m1 p <-> initialized m2 p.

Lemma mem_ext_app : forall m1 m2 ops, mem_ext m1 m2 ->
  mem_ext (m1 ++ ops) (m2 ++ ops).
Proof.
  repeat intro; split; intro.
  - repeat rewrite <- app_assoc.
    destruct H as [H _]; rewrite H; reflexivity.
  - unfold initialized.
    repeat rewrite lower_app; split; intros (v & Hlast);
      rewrite last_op_app in Hlast; destruct Hlast;
      try solve [exists v; rewrite last_op_app; clarify].
    + destruct H as [_ H]; specialize (H p); destruct H as [H _].
      clarify; exploit H; unfold initialized; eauto.
      intros (v' & ?); exists v'; rewrite last_op_app; clarify.
    + destruct H as [_ H]; specialize (H p); destruct H as [_ H].
      clarify; exploit H; unfold initialized; eauto.
      intros (v' & ?); exists v'; rewrite last_op_app; clarify.
Qed.

Global Instance mem_ext_refl : RelationClasses.Reflexive mem_ext.
Proof. repeat intro; split; reflexivity. Qed.

Global Instance mem_ext_sym : RelationClasses.Symmetric mem_ext.
Proof.
  intros ?? (? & ?).
  split; symmetry; auto.
Qed.

Global Instance mem_ext_trans : RelationClasses.Transitive mem_ext.
Proof.
  intros ??? (Hext1 & Hinit1) (Hext2 & Hinit2); split; intro.
  - rewrite (Hext1 ops); auto.
  - rewrite (Hinit1 p); auto.
Qed.

Lemma init_comm : forall m1 ops1 ops2 m2 p (Hprog1 : Forall prog_op ops1),
  initialized (m1 ++ ops1 ++ ops2 ++ m2) p ->
  initialized (m1 ++ ops2 ++ ops1 ++ m2) p.
Proof.
  unfold initialized; clarify.
  repeat rewrite lower_app in H; repeat rewrite lower_app.
  repeat rewrite last_op_app in H; destruct H as [[[? | ?] | ?] | ?].
  - exists x; repeat rewrite last_op_app; auto.
  - destruct (find (fun c => writesb c p) (rev ops1)) eqn: Hfind.
    + assert (exists v, write_val c = Some v) as (v & ?).
      { rewrite find_spec in Hfind; clarify.
        exploit nth_error_in; eauto; rewrite <- in_rev; intro.
        rewrite Forall_forall in Hprog1; exploit Hprog1; eauto; intro.
        destruct c; clarify; eauto. }
      exists v; rewrite last_op_app; left.
      rewrite last_op_app; left.
      rewrite last_op_app; right; clarify.
      rewrite last_write; eauto.
    + exists x; rewrite last_op_app; left.
      rewrite last_op_app; right; rewrite Forall_app; clarify.
      rewrite find_fail, Forall_rev in Hfind.
      clear - Hfind; induction ops1; clarify.
      * unfold lower; simpl; auto.
      * rewrite lower_cons, Forall_app; inversion Hfind; clarify.
        destruct a; clarify; unfold beq in *; constructor; clarify.
  - exists x; rewrite Forall_app in *; repeat rewrite last_op_app; clarify.
  - exists x; repeat rewrite last_op_app; repeat rewrite Forall_app in *;
      clarify.
Qed.

Corollary init_comm' : forall m1 ops1 ops2 p (Hprog1 : Forall prog_op ops1)
  (Hprog2 : Forall prog_op ops2),
  initialized (m1 ++ ops1 ++ ops2) p <-> initialized (m1 ++ ops2 ++ ops1) p.
Proof.
  intros; split; intro.
  - rewrite <- (app_nil_r (m1 ++ ops1 ++ ops2)), <- app_assoc, <- app_assoc
      in H.
    exploit init_comm; try apply H; auto; rewrite app_nil_r; auto.
  - rewrite <- (app_nil_r (m1 ++ ops2 ++ ops1)), <- app_assoc, <- app_assoc
      in H.
    exploit init_comm; try apply H; auto; rewrite app_nil_r; auto.
Qed.

Lemma can_read_iff_SC: forall p ops m v
  (Hcon : consistent (m ++ ops)) (Hprog : Forall prog_op ops)
  (Hno_write : Forall (fun c => match c with Write _ x _ | ARW _ x _ _ => p <> x
     | _ => True end) ops),
  can_read (m ++ ops) p v <-> can_read m p v.
Proof.
  induction ops; clarify.
  { rewrite app_nil_r; reflexivity. }
  specialize (IHops (m ++ [a]) v); rewrite <- app_assoc in *;
    inversion Hprog; inversion Hno_write; clarify.
  rewrite IHops.
  destruct (eq_dec (loc_of a) p).
  - destruct a; clarify.
    unfold can_read; rewrite <- app_assoc.
    simpl; rewrite read_noop_SC; [reflexivity|].
    eapply consistent_app_SC; rewrite <- app_assoc; simpl; eauto.
  - unfold can_read; rewrite <- app_assoc.
    simpl; rewrite loc_valid_ops2_SC; auto.
    + split; clarify.
      eapply consistent_app_SC; rewrite <- app_assoc; simpl; eauto.
    + constructor; clarify.
Qed.

Lemma writesb_write : forall c p v (Hwrite : writesb c p = true)
  (Hval : write_val c = Some v),
  exists i, nth_error (to_seq c) i = Some (MWrite p v).
Proof.
  destruct c; clarify.
  - unfold beq in Hwrite; exists 0; clarify.
  - unfold beq in Hwrite; exists 1; clarify.
Qed.

Lemma writesb_val : forall c p (Hwrite : writesb c p = true)
  (Hprog : prog_op c), exists v, write_val c = Some v.
Proof.
  destruct c; clarify; eauto.
Qed.

Notation lower := (@lower _ _ _ _ _ Base).

Typeclasses eauto := 4.

Lemma lift_last : forall ops p a
  (Hlast : last_op (lower ops) (Ptr p) a) (Hprog : Forall prog_op ops),
  exists i w, nth_error ops i = Some w /\ last_op (to_seq w) (Ptr p) a /\
    forall i2 w2, nth_error ops i2 = Some w2 -> writesb w2 p = true -> i2 <= i.
Proof.
  intros.
  assert (exists i, last_mod_op (lower ops) (Ptr p) i /\
    inth (lower ops) i = Some a) as (i & Hlast_mod & Hnth) by eauto.
  inversion Hlast_mod; setoid_rewrite Hop1 in Hnth; clarify.
  rewrite inth_nth_error in Hop1; generalize (nth_lower_split _ _ Hop1);
    intros (ops1 & c & ops2 & i' & ? & Hi' & ?); clarify.
  exists (length ops1); rewrite nth_error_split; do 2 eexists; eauto.
  rewrite lower_app, lower_cons in Hlast.
  repeat setoid_rewrite last_op_app in Hlast.
  destruct Hlast as [[Hlast | Hlast] | Hlast].
  - destruct Hlast as (i2 & Hi2).
    specialize (Hlast0 (length (lower ops1) + (length (to_seq c) + i2))).
    rewrite inth_nth_error, lower_app, lower_cons in Hlast0.
    repeat rewrite nth_error_plus in Hlast0; specialize (Hlast0 a); clarsimp.
    generalize (nth_error_lt _ _ Hi'); intro; exfalso.
    apply plus_le_reg_l in Hlast0.
    assert (length (to_seq c) <= i') by omega.
    rewrite Nat.le_ngt in *; contradiction.
  - split; [clarify | intros i2 w2 Hw2 Hmods2].
    rewrite nth_error_app in *; destruct (lt_dec i2 (length ops1)); [omega|].
    destruct (i2 - length ops1) eqn: Hminus; [omega | clarify].
    rewrite Forall_app in Hprog; destruct Hprog as [_ Hprog];
      inversion Hprog as [|??? Hprog2]; subst.
    exploit nth_error_split'; eauto; clarify.
    rewrite Forall_app in Hprog2; clarify; inversion Hprog22; subst.
    exploit writesb_val; eauto; intros (v & ?).
    exploit writesb_write; eauto; intros (i2' & ?).
    specialize (Hlast0 (length (lower ops1) + (length (to_seq c) +
      (length (lower x) + i2')))).
    rewrite inth_nth_error in Hlast0; repeat rewrite lower_app in Hlast0.
    rewrite nth_error_plus, lower_cons, nth_error_plus in Hlast0.
    setoid_rewrite lower_app in Hlast0; rewrite nth_error_plus in Hlast0.
    setoid_rewrite lower_cons in Hlast0; rewrite nth_error_app in Hlast0.
    exploit nth_error_lt; eauto; clarify.
    specialize (Hlast0 (MWrite p v)); clarify.
    rewrite <- NPeano.Nat.add_le_mono_l in Hlast0.
    assert (i' < length (to_seq c) + (length (lower x) + i2')) as Hlt.
    { generalize (nth_error_lt _ _ Hi'); intro.
      eapply lt_le_trans; [eauto | apply le_plus_l]. }
    omega.
  - rewrite Forall_app in *; clarify.
    generalize (nth_error_in _ _ Hi'); intro.
    rewrite Forall_forall in Hlast21; specialize (Hlast21 a); clarify.
Qed.

Lemma can_read_write_SC: forall p ops m v
  (Hcon : consistent (m ++ ops)) (Hprog : Forall prog_op ops) c v'
  (Hin : In c ops) (Hp : writesb c p = true) (Hv : write_val c = Some v')
  (Hwrite : Forall (fun c => writesb c p = true -> write_val c = Some v') ops),
  can_read (m ++ ops) p v <-> v = v'.
Proof.
  intros.
  unfold can_read, consistent, SC; rewrite lower_app, lower_single; simpl.
  rewrite read_last; auto; try reflexivity.
  assert (exists a, last_op (lower (m ++ ops)) (Ptr p) a) as (a & Hlast).
  { exploit in_split; eauto; intros (ops1 & ops2 & ?); subst.
    exploit writesb_write; eauto; intros (i & Hi).
    generalize (has_last_op(op := MWrite p v') _ (length (lower m) +
      (length (lower ops1) + i)) Hcon); intro X; use X.
    destruct X as (i' & Hlast); inversion Hlast.
    exists op, i'; auto.
    { rewrite lower_app, nth_error_plus, lower_app, nth_error_plus.
      rewrite lower_cons, nth_error_app; exploit nth_error_lt; eauto; clarify. }
  }
  rewrite lower_app, last_op_app in Hlast; destruct Hlast as [Hlast | Hlast].
  - rewrite lower_app, last_op_app; left.
    exploit lift_last; eauto; intros (? & w & ? & Hlast' & ?); clarify.
    exploit nth_error_in; eauto; intro.
    rewrite Forall_forall in *; exploit Hprog; eauto; intro.
    destruct w; clarify; try rewrite last_single in Hlast'; clarify.
    + destruct (eq_dec x0 p); clarify.
      exploit Hwrite; eauto; simpl; unfold beq; clarify.
    + destruct Hlast' as (i & Hlast' & ?); destruct i; inversion Hlast';
        clarsimp.
      destruct i; clarify; [|rewrite inth_nil in *; clarify].
      destruct (eq_dec x0 p); clarify.
      exploit Hwrite; eauto; simpl; unfold beq; clarify.
  - clarify.
    rewrite Forall_forall in Hlast2; exploit Hlast2.
    { exploit writesb_write; eauto; clarify.
      eapply flatten_in; setoid_rewrite in_map_iff; do 2 eexists; eauto.
      eapply nth_error_in; eauto. }
    clarify.
Qed.

Lemma writesb_loc : forall w p (Hwrite : writesb w p = true)
  (Hprog : prog_op w), loc_of w = p.
Proof.
  destruct w; clarify; unfold beq in *; clarify.
Qed.

Lemma init_snoc : forall m c p (Hinit : initialized (m ++ [c]) p),
  writesb c p = true \/ initialized m p.
Proof.
  unfold initialized in *; clarify.
  rewrite lower_app, last_op_app in Hinit; destruct Hinit; [|clarify; eauto].
  destruct H as (i & Hlast & ?); inversion Hlast; clarsimp.
  rewrite lower_single in H; destruct c; simpl in *;
    try rewrite nth_error_single in *; unfold beq; clarify.
  destruct i; clarify; rewrite nth_error_single in *; clarify.
Qed.

Definition read_val c :=
  match c with
  | Read _ _ v | ARW _ _ v _ => Some v
  | _ => None
  end.

Lemma no_write_read : forall c (Hprog : prog_op c)
  (Hno_write : writesb c (loc_of c) = false), exists t p v, c = Read t p v.
Proof.
  destruct c; clarify; unfold beq in *; clarify; eauto.
Qed.

Lemma ARW_write : forall m t p v v' (Hcon : consistent (m ++ [ARW t p v v']))
  ops, consistent (m ++ ARW t p v v' :: ops) <->
       consistent (m ++ Write t p v' :: ops).
Proof.
  intros.
  unfold consistent, SC in *.
  do 2 rewrite lower_app, lower_cons; simpl.
  rewrite split_app, to_ilist_app, to_ilist_app.
  apply read_noop.
  rewrite lower_app, lower_single in Hcon; simpl in Hcon.
  eapply consistent_app; rewrite <- app_assoc; simpl; eauto.
Qed.

Lemma can_read_written_SC: forall m t p v (Hcon: consistent (m++[Write t p v])),
                             can_read (m++[Write t p v]) p v.
Proof.
  intros.
  unfold can_read. rewrite <- app_assoc. unfold consistent, SC, seq_con in *. repeat rewrite lower_app in *. repeat rewrite lower_single in *. clarify. rewrite read_written; auto.
  rewrite lower_app, lower_single in Hcon. clarify.
Qed.

Lemma consistent_next_write : forall m c1 c2 v (Hprog1 : prog_op c1)
  (Hprog2 : prog_op c2) (Hcon : consistent (m ++ [c1]))
  (Hloc : loc_of c1 = loc_of c2) (Hwrite : writesb c1 (loc_of c1) = true)
  (Hval : write_val c1 = Some v)
  (Hcond : match read_val c2 with Some v' => v' = v | None => True end),
  consistent (m ++ [c1; c2]).
Proof.
  intros.
  assert (forall t, consistent (m ++ [Write t (loc_of c1) v; c2])).
  assert (consistent (m ++ [Write (thread_of c1) (loc_of c1) v])).
  { destruct c1; clarify.
    rewrite ARW_write in Hcon; auto. }
  generalize (write_any_SC _ _ _ _ H); intro Hcan.
  intro; generalize (can_write_thread v t Hcan); intro Hcon'.
  generalize (can_write_SC Hcan Hcon'); intro Hcan'.
  use Hcan'; [|constructor; simpl; auto].
  generalize (can_read_written_SC _ _ _ _ Hcon'); intro.
  destruct c2; clarify.
  - exploit can_read_thread; eauto.
    rewrite <- app_assoc; simpl; eauto.
  - exploit can_write_thread; eauto.
    rewrite <- app_assoc; simpl; eauto.
  - rewrite split_app; apply can_arw_SC; auto.
  - destruct c1; clarify.
    rewrite ARW_write; auto.
Qed.

Lemma read_written_SC : forall m p v v' t t'
  (Hcon : consistent (m ++ [Write t p v])),
  consistent (m ++ [Write t p v; Read t' p v']) <-> v' = v.
Proof.
  intros.
  unfold consistent, SC in *; rewrite lower_app; rewrite lower_app in Hcon.
  rewrite lower_cons; rewrite lower_single; rewrite lower_single in Hcon;
    simpl in *.
  apply read_written; auto.
Qed.

Lemma consistent_next_write_iff : forall m c1 c2 v (Hprog1 : prog_op c1)
  (Hprog2 : prog_op c2) (Hcon : consistent (m ++ [c1]))
  (Hloc : loc_of c1 = loc_of c2) (Hwrite : writesb c1 (loc_of c1) = true)
  (Hval : write_val c1 = Some v),
  consistent (m ++ [c1; c2]) <->
  match read_val c2 with Some v' => v' = v | None => True end.
Proof.
  split; intro.
  - destruct (read_val c2) eqn: Hread; auto.
    assert (consistent (m ++ [c1; Read (thread_of c2) (loc_of c2) n])) as Hcon'.
    { destruct c2; clarify.
      rewrite split_app, can_arw_SC_iff in H.
      specialize (H 0); eapply consistent_app_SC.
      do 2 rewrite <- app_assoc in H; rewrite <- app_assoc; simpl in *; eauto. }
    assert (consistent (m ++ [Write (thread_of c1) (loc_of c1) v;
        Read (thread_of c2) (loc_of c2) n])).
    { destruct c1; clarify.
      rewrite ARW_write in Hcon'; auto. }
    rewrite Hloc in *; rewrite <- read_written_SC; eauto.
    eapply consistent_app_SC; rewrite <- app_assoc; simpl; eauto.
  - eapply consistent_next_write; eauto.
Qed.

Lemma can_arw_SC_iff' : forall p m v v' t,
  consistent (m ++ [ARW t p v v']) <-> can_read m p v /\ can_write m p.
Proof.
  intros; rewrite can_arw_SC_iff; split; intro.
  - unfold can_write in *; split.
    + eapply can_read_thread'.
      specialize (H 0); eapply consistent_app_SC; eauto.
    + intro v1; specialize (H v1); rewrite <- app_assoc in H; simpl in H.
      rewrite read_noop_SC in H; auto.
      eapply consistent_drop; eauto.
  - eapply can_write_SC; clarify.
    + apply can_read_thread; auto.
    + constructor; simpl; auto.
Qed.

Lemma can_acquire_SC: forall t t' m l (Hcon: consistent (m ++ [Rel t l])),
 consistent (m ++ [Rel t l; Acq t' l]).
Proof.
  intros.
  rewrite split_app, can_arw_SC_iff'; split.
  - eapply can_read_thread'; rewrite read_arwritten_SC; auto.
  - apply can_write_SC; auto.
    rewrite can_arw_SC_iff' in Hcon; clarify.
    { constructor; simpl; auto. }
Qed.

Lemma can_release_SC: forall t m l (Hcon: consistent (m ++ [Acq t l])),
 consistent ((m ++ [Acq t l]) ++ [Rel t l]).
Proof.
  intros.
  rewrite can_arw_SC_iff'; split.
  - eapply can_read_thread'; rewrite read_arwritten_SC; auto.
  - apply can_write_SC; auto.
    rewrite can_arw_SC_iff' in Hcon; clarify.
    { constructor; simpl; auto. }
Qed.

Definition lock_op x a := exists t, a = Acq t x \/ a = Rel t x.

Lemma lock_hold : forall m l t ops (Hinit : initialized m (l, 0))
  (Hheld : can_read m (l, 0) (S t)) (Hcon : consistent (m ++ ops))
  (Hprog : Forall prog_op ops) (Hlock : Forall (fun a => loc_of a = (l, 0) ->
     lock_op l a) ops),
  can_read (m ++ ops) (l, 0) (S t) \/ In (Rel t l) ops.
Proof.
  induction ops using rev_ind; clarsimp.
  rewrite app_assoc in Hcon; exploit consistent_app_SC; eauto.
  rewrite Forall_app in *; clarify.
  inversion Hlock2 as [|?? Hx]; inversion Hprog2; rewrite in_app; clarify.
  unfold can_read in *.
  repeat rewrite <- app_assoc in *; simpl.
  destruct (eq_dec (loc_of x) (l, 0)).
  - unfold lock_op in Hx; clarify.
    destruct Hx as [? | ?]; clarify.
    + rewrite app_assoc, can_arw_SC_iff in Hcon.
      specialize (Hcon 0); exploit consistent_app_SC; eauto; intro.
      exploit can_read_thread'; eauto; intro.
      rewrite app_assoc in IHops.
      generalize (init_steps Hinit Hprog1); intro.
      generalize (can_read_unique(m := m ++ ops)(p := (l, 0)) (S t) 0); clarify.
    + rewrite app_assoc, can_arw_SC_iff in Hcon.
      specialize (Hcon 0); exploit consistent_app_SC; eauto; intro.
      exploit can_read_thread'; eauto; intro.
      rewrite app_assoc in IHops.
      generalize (init_steps Hinit Hprog1); intro.
      generalize (can_read_unique(m := m ++ ops)(p := (l, 0)) (S t) (S x0));
        intro Heq; clarify.
      inversion Heq; auto.
  - rewrite app_assoc, loc_valid_SC; clarify.
    repeat rewrite <- app_assoc in *; clarify.
Qed.

Corollary lock_hold2 : forall m l t ops
  (Hcon : consistent (m ++ Acq t l :: ops))
  (Hprog : Forall prog_op ops) (Hlock : Forall (fun a => loc_of a = (l, 0) ->
     lock_op l a) ops),
  can_read (m ++ Acq t l :: ops) (l, 0) (S t) \/ In (Rel t l) ops.
Proof.
  intros; rewrite split_app in *; apply lock_hold; auto.
  - unfold initialized; rewrite lower_app, lower_single; simpl.
    eexists; rewrite last_op_app; left.
    exists 1; clarify.
    econstructor; simpl; eauto.
    destruct j; clarify.
    destruct j; clarify.
    rewrite inth_nil in *; clarify.
  - apply can_read_arwritten.
    eapply consistent_app_SC; eauto.
Qed.

Lemma delay_rel' : forall m t l ops (Hcon : consistent (m ++ [Rel t l]))
  (Hops : Forall (fun a => loc_of a = (l, 0) -> lock_op l a) ops)
  (Ht : Forall (fun a => a <> Rel t l) ops) (Hcon' : consistent (m ++ ops))
  (Hprog : Forall prog_op ops) (Hinit : initialized m (l, 0)),
  consistent (m ++ ops ++ [Rel t l]).
Proof.
  intros.
  rewrite app_assoc; rewrite can_arw_SC_iff' in Hcon; rewrite can_arw_SC_iff';
    clarify; split.
  - exploit lock_hold; eauto; clarify.
    rewrite Forall_forall in Ht; exploit Ht; eauto; contradiction.
  - apply can_write_SC; auto.
Qed.

Corollary delay_rel : forall m t l ops (Hcon : consistent (m ++ [Rel t l]))
  (Hops : Forall (fun a => loc_of a = (l, 0) -> lock_op l a) ops)
  (Ht : Forall (fun a => thread_of a <> t) ops) (Hcon' : consistent (m ++ ops))
  (Hprog : Forall prog_op ops) (Hinit : initialized m (l, 0)),
  consistent (m ++ ops ++ [Rel t l]).
Proof.
  intros; apply delay_rel'; auto.
  eapply Forall_impl; [|apply Ht].
  repeat intro; clarify.
Qed.

Lemma consistent_next : forall m1 m2 c1 c2
  (Hprog1 : prog_op c1) (Hprog2 : prog_op c2)
  (Hcon : consistent (m1 ++ [c1; c2])) (Hcon2 : consistent (m2 ++ [c1]))
  (Himp : consistent (m1 ++ [c2]) -> consistent (m2 ++ [c2])),
  consistent (m2 ++ [c1; c2]).
Proof.
  intros.
  exploit consistent_drop; eauto; intro.
  destruct (eq_dec (loc_of c1) (loc_of c2)).
  - destruct (writesb c1 (loc_of c1)) eqn: Hwrite.
    + exploit writesb_val; eauto; clarify.
      rewrite consistent_next_write_iff in Hcon; eauto.
      rewrite consistent_next_write_iff; eauto.
    + exploit no_write_read; try apply Hwrite; clarify.
      rewrite read_noop_SC in Hcon; rewrite read_noop_SC; auto.
      rewrite app_nil_r; eapply consistent_app_SC; eauto.
  - rewrite loc_valid_SC in Hcon; clarify.
    rewrite loc_valid_SC; clarify.
Qed.

Lemma rel_rel : forall m t t' l, ~consistent (m ++ [Rel t l; Rel t' l]).
Proof.
  repeat intro.
  rewrite split_app, can_arw_SC_iff' in H; clarify.
  exploit can_read_thread; eauto.
  rewrite read_arwritten_SC; [|eapply consistent_app_SC; eauto].
  intro Heq; inversion Heq.
Qed.

Lemma init_write : forall m c p (Hprog : prog_op c), writesb c p = true ->
  initialized (m ++ [c]) p.
Proof.
  unfold initialized; intros.
  rewrite lower_app, lower_single.
  setoid_rewrite last_op_app.
  destruct c; clarify; eexists; left.
  - unfold beq in *; clarify.
    exists 0; split; simpl; eauto.
    econstructor; simpl; eauto; clarify.
    destruct j; clarify.
    rewrite inth_nil in *; clarify.
  - unfold beq in *; clarify.
    exists 1; split; simpl; eauto.
    econstructor; simpl; eauto; clarify.
    destruct j; clarify.
    destruct j; clarify.
    rewrite inth_nil in *; clarify.
Qed.

Lemma init_can_read : forall m p (Hinit : initialized m p)
  (Hcon : consistent m), exists v, can_read m p v.
Proof.
  unfold initialized; intros.
  destruct Hinit as (v & Hlast); exists v.
  rewrite init_read; auto.
  rewrite <- last_write; auto.
  { eexists; eauto. }
Qed.

Lemma init_can_write: forall m x (Hinit : initialized m x)
  (Hcon : consistent m), can_write m x.
Proof.
  unfold initialized, can_write; clarify.
  unfold consistent, SC in *; destruct Hinit as (i & Hlast & Hi).
  rewrite lower_app, lower_single; simpl.
  rewrite inth_nth_error in Hi; exploit nth_error_split'; eauto;
    intros (m1 & m2 & ? & Heq); rewrite Heq in *.
  rewrite <- app_assoc; simpl.
  rewrite split_app, not_mod_ops_write.
  - rewrite <- app_assoc; simpl.
    rewrite write_not_read_single; clarify.
    rewrite split_app in Hcon.
    generalize (consistent_app _ _ Hcon); intro Hcon'; clarify.
    rewrite write_any_value in Hcon'; eauto.
  - rewrite Forall_forall; intros a ?.
    exploit in_nth_error; eauto; intros (i' & ?).
    inversion Hlast.
    specialize (Hlast0 (length m1 + S i') a).
    rewrite inth_nth_error, nth_error_plus in Hlast0; clarify.
    destruct a; clarify; omega.
  - rewrite <- app_assoc; simpl; auto.
Qed.

Lemma can_read_step' : forall m1 m2 p v c
  (Hcan : can_read m1 p v <-> can_read m2 p v) (Hprog : prog_op c)
  (Hcon1 : consistent (m1 ++ [c])) (Hcon2 : consistent (m2 ++ [c])),
  can_read (m1 ++ [c]) p v <-> can_read (m2 ++ [c]) p v.
Proof.
  intros.
  unfold can_read; repeat rewrite <- app_assoc; simpl; split; intro;
    eapply consistent_next; eauto; clarify.
  - rewrite <- Hcan; auto.
  - rewrite Hcan; auto.
Qed.

Lemma loc_partition : forall f ops m (Hcon : consistent (m ++ ops))
  ops1 ops2 (Hpart : partition f ops = (ops1, ops2))
  (Hops : Forall prog_op ops) (Hindep : indep ops1 ops2),
  consistent (m ++ ops2).
Proof.
  setoid_rewrite partition_filter.
  induction ops; clarify.
  specialize (IHops (m ++ [a])); rewrite <- app_assoc in IHops; clarify.
  specialize (IHops _ _ eq_refl).
  inversion Hops; subst.
  destruct (f a); clarify.
  - inversion Hindep; clarify.
    rewrite <- app_assoc, loc_valid_ops_SC in IHops; clarify.
    apply Forall_filter; auto.
  - rewrite <- app_assoc in IHops; apply IHops.
    rewrite Forall_forall in *; intros ? Hin.
    specialize (Hindep _ Hin); inversion Hindep; auto.
Qed.

Lemma indep_sym : forall ops1 ops2, indep ops1 ops2 -> indep ops2 ops1.
Proof.
  repeat setoid_rewrite Forall_forall; repeat intro.
  eapply H; eauto.
Qed.

Lemma loc_split_iff : forall f ops ops1 ops2
  (Hpart : partition f ops = (ops1, ops2))
  (Hops : Forall prog_op ops) (Hindep : indep ops1 ops2) m m2,
  consistent (m ++ ops ++ m2) <-> consistent (m ++ ops1 ++ ops2 ++ m2).
Proof.
  setoid_rewrite partition_filter.
  induction ops; clarify.
  { reflexivity. }
  specialize (IHops _ _ eq_refl).
  assert (indep (filter f ops) (filter (fun x : conc_op => negb (f x)) ops)).
  { destruct (f a); clarify.
    - inversion Hindep; auto.
    - apply indep_sym in Hindep; apply indep_sym; inversion Hindep; auto. }
  inversion Hops; clarify.
  specialize (IHops (m ++ [a]) m2); repeat rewrite <- app_assoc in IHops;
    rewrite IHops.
  destruct (f a); clarify.
  - reflexivity.
  - apply loc_comm_ops1_SC; auto.
    + apply indep_sym in Hindep; inversion Hindep; auto.
    + apply Forall_filter; auto.
Qed.

End SC.


From iris.algebra Require Import proofmode_classes.
From iris.proofmode Require Import classes.
From iris.base_logic Require Export derived.
From iris.prelude Require Import options.
Import base_logic.bi.uPred.

(* Setup of the proof mode *)
Section class_instances.
  Context {M : ucmra}.
  Implicit Types P Q R : uPred M.

  Global Instance into_pure_cmra_valid `{!CmraDiscrete A} (a : A) :
    @IntoPure (uPredI M) (✓ a) (✓ a).
  Proof. by rewrite /IntoPure discrete_valid. Qed.

  Global Instance from_pure_cmra_valid {A : cmra} (a : A) :
    @FromPure (uPredI M) false (✓ a) (✓ a).
  Proof.
    rewrite /FromPure /=. eapply bi.pure_elim=> // ?.
    rewrite -uPred.cmra_valid_intro //.
  Qed.

  Global Instance from_sep_ownM (a b1 b2 : M) :
    IsOp a b1 b2 →
    FromSep (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
  Proof. intros. by rewrite /FromSep -ownM_op -is_op. Qed.
  (* TODO: Improve this instance with generic own simplification machinery
  once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *)
  Global Instance combine_sep_as_ownM (a b1 b2 : M) :
    IsOp a b1 b2 →
    CombineSepAs (uPred_ownM b1) (uPred_ownM b2) (uPred_ownM a).
  Proof. intros. by rewrite /CombineSepAs -ownM_op -is_op. Qed.
  (* TODO: Improve this instance with generic own validity simplification
  machinery once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *)
  Global Instance combine_sep_gives_ownM (b1 b2 : M) :
    CombineSepGives (uPred_ownM b1) (uPred_ownM b2) (✓ (b1 ⋅ b2)).
  Proof.
    intros. rewrite /CombineSepGives -ownM_op ownM_valid.
    by apply: bi.persistently_intro.
  Qed.
  Global Instance from_sep_ownM_core_id (a b1 b2 : M) :
    IsOp a b1 b2 → TCOr (CoreId b1) (CoreId b2) →
    FromAnd (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
  Proof.
    intros ? H. rewrite /FromAnd (is_op a) ownM_op.
    destruct H; by rewrite bi.persistent_and_sep.
  Qed.

  Global Instance into_and_ownM p (a b1 b2 : M) :
    IsOp a b1 b2 → IntoAnd p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
  Proof.
    intros. apply bi.intuitionistically_if_mono. by rewrite (is_op a) ownM_op bi.sep_and.
  Qed.

  Global Instance into_sep_ownM (a b1 b2 : M) :
    IsOp a b1 b2 → IntoSep (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
  Proof. intros. by rewrite /IntoSep (is_op a) ownM_op. Qed.
End class_instances.


Require Import ExtLib.Structures.Monad.
Require Import ExtLib.Structures.MonadTrans.

Set Implicit Arguments.
Set Contextual Implicit.
Set Maximal Implicit Insertion.

Section ContType.
  Variable R : Type.

(*
  Record cont (t : Type) : Type := mkCont
  { runCont : (t -> Ans) -> Ans }.

  Global Instance Monad_cont : Monad cont :=
  { ret  := fun _ v => mkCont (fun k => k v)
  ; bind := fun _ c1 _ c2 =>
    mkCont (fun k =>
      runCont c1 (fun t =>
        runCont (c2 t) k))
  }.

  Global Instance Cont_cont : Cont cont :=
  { callCC := fun _ _ f => mkCont (fun c => runCont (f (fun x => mkCont (fun _ => c x))) c)
  }.

  Definition mapCont (f : Ans -> Ans) {a} (c : cont a) : cont a :=
    mkCont (fun x => f (runCont c x)).

  Definition withCont {a b} (f : (b -> Ans) -> (a -> Ans)) (c : cont a) : cont b :=
    mkCont (fun x => runCont c (f x)).
*)

  Variable M : Type -> Type.

  Record contT (A : Type) : Type := mkContT
  { runContT : (A -> M R) -> M R }.

  Global Instance Monad_contT : Monad contT :=
  { ret := fun _ x => mkContT (fun k => k x)
  ; bind := fun _ _ c1 c2 =>
    mkContT (fun c =>
      runContT c1 (fun a => runContT (c2 a) c))
  }.

  Global Instance MonadT_contT {Monad_M : Monad M} : MonadT contT M :=
  { lift := fun _ c => mkContT (bind c)
  }.

(*
  Definition mapContT (f : m Ans -> m Ans) {a} (c : contT a) : contT a :=
    mkContT (fun x => f (runContT c x)).

  Definition withContT {a b} (f : (b -> m Ans) -> (a -> m Ans)) (c : contT a) : contT b :=
    mkContT (fun x => runContT c (f x)).
*)

End ContType.

Definition resetT {M} {Monad_M : Monad M} {R R'} (u : contT R M R) : contT R' M R :=
  mkContT (fun k => bind (runContT u ret) k).

Definition shiftT {M} {Monad_M : Monad M} {R A}
    (f : (A -> M R) -> contT R M R) : contT R M A :=
  mkContT (fun k => runContT (f k) ret).