Require Import Coq.Sets.Ensembles.
Require Import  Coq.omega.Omega.
Require Import Coq.Lists.List.

Require Coq.Bool.Bool.
Require Coq.Lists.ListDec.

Require Import Coq.Strings.String.

Require Export SmedlAST_submission.
Require Export semantic_rules.

Local Close Scope Z_scope.
Local Close Scope N_scope.
Local Close Scope Q_scope.
(*aux lemma for proving termination*)
Lemma termL40': forall l1 l2, List.length (l1) <=
List.length (mergeList' (l1) (l2) scenario_dec).
Proof. intros.  generalize dependent l2.   induction l1.
intros.  simpl. omega.
intros. simpl.
assert (forall (A:Type) (l l1: list A), Datatypes.length (l1) <= Datatypes.length ((l1) ++ l)).
intros. induction l0. simpl. omega. simpl. omega. destruct H with (A:=scenario) (l1:=l1) (l:=filterList (a :: l1) l2 scenario_dec).
 omega. omega.
Qed.

(*aux lemma for proving termination*)
Lemma termL41': forall M (conf conf' : configuration M) v, innerCombineFunc'''' conf v = Some conf'
-> (Datatypes.length (finishedscenarios conf) <= Datatypes.length (finishedscenarios conf')).
Proof. intros. generalize dependent conf. generalize dependent conf'.     induction v.
intros.  simpl in H. inversion H.
intros.
simpl in H.
destruct v.

remember (mergeConfigFunc' conf conf a ).

destruct e;inversion H;subst.
unfold mergeConfigFunc' in Heqe.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate a)).
destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate a)).
inversion Heqe. simpl.
 rewrite app_length. omega.
 inversion Heqe. inversion Heqe.
 remember (innerCombineFunc'''' conf (c :: v)).
 destruct o;inversion H.
 symmetry in Heqo. apply IHv in Heqo.

 remember (mergeConfigFunc' conf a c0).
 destruct e;inversion H.
 subst.
unfold mergeConfigFunc' in Heqe.
destruct (mergeDataStateFunc (datastate conf) (datastate a) (datastate c0)).
destruct (mergeControlStateFunc (controlstate conf) (controlstate a) (controlstate c0)).
inversion Heqe.
simpl.  clear H2.
rewrite app_length. omega.
inversion Heqe.
inversion Heqe.

(*remember (innerCombineFunc'''' conf v).
destruct o;inversion H.  unfold mergeConfigFunc' in H1.
destruct (mergeDataStateFunc (datastate conf) (datastate c) (datastate a)).
destruct (mergeControlStateFunc (controlstate conf) (controlstate c) (controlstate a)).
inversion H1. simpl. assert (Datatypes.length (finishedscenarios conf) <=
                             Datatypes.length (finishedscenarios c)).
apply IHv;auto. rewrite app_length. omega. inversion H1. inversion H1.
unfold mergeConfigFunc' in H1.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate a)).
destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate a)).
inversion H1. simpl. rewrite app_length. omega. inversion H1. inversion H1. *)

Qed.

Lemma termL2: forall M (conf : configuration M) e lst scs conf', constructConfigList' scs e conf = Result lst /\
 In conf' lst -> exists sce, In sce scs /\  Result conf' = constructConfig sce e conf.
Proof.
intros. destruct H.  generalize dependent lst. induction scs.
- intros. simpl in H. induction lst. inversion H0. inversion H.
- intros. induction lst. simpl in H. inversion H0. simpl in H.

  simpl in H0. destruct H0. remember (constructConfig a e conf ). destruct e0.
  destruct (constructConfigList' scs e). inversion H;subst. exists a. split. simpl;left. auto. apply Heqe0. inversion H.
inversion H. inversion H.  simpl. destruct  (constructConfig a e conf ).

 remember (constructConfigList' scs e conf).
destruct e0. inversion H.  subst. destruct IHscs with lst;auto.   exists x.
destruct H1. split. right;auto. auto. inversion H. inversion H.
Qed.

Lemma termL3: forall M (conf conf' : configuration M) e sce,
    Result conf' = constructConfig sce e conf  ->
    (finishedscenarios conf' = sce::nil).
Proof.
intros. unfold constructConfig in H.
destruct (getScenarioState sce (controlstate conf)).
destruct (transEvMapFunc (stateEvDefInstanceMap M) (Some s, Some (eventDefinition e))).
destruct (findEventInstance e (datastate conf) l).
destruct (createValueEnv (eventArgs e0) (eventParams (eventDefinition e)) (eventArguments e)) .
destruct (getStep' conf sce e0).
  unfold  configTransition in H.
destruct (execAction (extendValEnv (datastate conf) v, nil) (stepActions s0)
            (filter
               (fun e : event_definition =>
                match eventKind e with
                | Internal => true
                | Imported => false
                | Exported => true
                end) (events M))).
destruct v0. inversion H;subst. simpl;auto.

repeat(inversion H). inversion H. inversion H. inversion H. inversion H. inversion H.
Qed.

Lemma termL23:  forall M (conf conf' : configuration M) e lst scs,
    constructConfigList scs e conf = Result lst /\
    In conf' lst -> exists sce, In sce scs /\ (finishedscenarios conf' = sce::nil).
Proof. intros.   apply termL2 in H. destruct H. exists x. destruct H.   split.  Focus 2.

       apply termL3 with (e:=e) (conf:=conf);auto.
 apply filter_In in H.    destruct H.
 apply filterL2 in H.  auto.
Qed.

(*Lemma 1*)
Lemma termL4: forall M (conf conf' : configuration M) e, synchrony conf conf' e ->
List.length (finishedscenarios conf) < List.length (finishedscenarios conf').
Proof.
intros.
repeat match goal with
            | [|- forall _,_]  => progress intros
            | [ |-  _  /\  _  ] =>  split
            | [ H: synchrony _ _ _ |- _ ] => unfold synchrony in H

            | [ H: _ /\ _ |- _ ] => destruct H
            | _ => unfold equivConf
end.
unfold combineFunc in H0.
remember (constructConfigList (dom (controlstate conf)) e conf).
destruct e0;inversion H0.    destruct v;inversion H0. clear H2.
clear H0.
destruct v.

remember (mergeConfigFunc' conf conf c).
destruct e0;inversion H3.
unfold removeEventFromConf. simpl.
unfold mergeConfigFunc' in Heqe1.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate c) ).
destruct (mergeControlStateFunc (controlstate conf) (controlstate conf)
                                (controlstate c)).
inversion Heqe1. simpl.
rewrite app_length.
pose proof termL23.
assert (exists sce : scenario, In sce (dom (controlstate conf)) /\ finishedscenarios c = sce :: nil).
eapply H0;auto. split. symmetry. apply Heqe0. left;auto.
destruct H4. destruct H4. rewrite H5;simpl.
omega.
inversion Heqe1. inversion Heqe1.
remember (innerCombineFunc'''' conf (c0 :: v)).
destruct o;inversion H3.

remember (mergeConfigFunc' conf c c1).
destruct e0;inversion H1.
unfold removeEventFromConf. simpl.
unfold mergeConfigFunc' in Heqe1.
destruct (mergeDataStateFunc (datastate conf) (datastate c) (datastate c1));inversion Heqe1. clear H4.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate c) (controlstate c1));inversion Heqe1. simpl.  rewrite app_length.
assert (Datatypes.length (finishedscenarios conf) <=
        Datatypes.length (finishedscenarios c1)).
pose proof  termL41'.
apply H0 with (v:=(c0::v));auto.
pose proof termL23.
assert (exists sce : scenario, In sce (dom (controlstate conf)) /\ finishedscenarios c = sce :: nil).
eapply H5;auto. split. symmetry. apply Heqe0. left;auto.
destruct H6. destruct H6. rewrite H7.
simpl. omega.
(*remember (innerCombineFunc'''' conf v).
destruct o;inversion H3.
remember (mergeConfigFunc' conf c0 c).
destruct e0;inversion H1.
unfold removeEventFromConf. simpl.
unfold mergeConfigFunc' in Heqe1.
destruct (mergeDataStateFunc (datastate conf) (datastate c0) (datastate c));inversion Heqe1. clear H4.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate c0) (controlstate c));inversion Heqe1. simpl.  rewrite app_length.
assert (Datatypes.length (finishedscenarios conf) <=
        Datatypes.length (finishedscenarios c0)).
pose proof  termL41'.
apply H0 with (v:=v);auto.
pose proof termL23.
assert (exists sce : scenario, In sce (dom (controlstate conf)) /\ finishedscenarios c = sce :: nil).
eapply H5;auto. split. symmetry. apply Heqe0. left;auto.
destruct H6. destruct H6. rewrite H7.
simpl. omega.

remember (mergeConfigFunc' conf conf c).
destruct e0;inversion H1.
unfold removeEventFromConf. simpl.
unfold mergeConfigFunc' in Heqe1.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate c) ).
destruct (mergeControlStateFunc (controlstate conf) (controlstate conf)
                                (controlstate c)).
inversion Heqe1. simpl.
rewrite app_length.
pose proof termL23.
assert (exists sce : scenario, In sce (dom (controlstate conf)) /\ finishedscenarios c = sce :: nil).
eapply H0;auto. split. symmetry. apply Heqe0. left;auto.
destruct H5. destruct H5. rewrite H6;simpl.
omega.
inversion Heqe1. inversion Heqe1. *)
Qed.

(*aux lemma for proving termination*)
Lemma sceInclusion: forall M (conf : configuration M), uniqList (dom (controlstate conf)) -> uniqList  (finishedscenarios conf)
-> scenarioInclusion conf->
 List.length (dom (controlstate conf)) >= List.length ( (finishedscenarios conf)).
Proof. intros.  apply listInclusion. split. auto. split. auto. unfold scenarioInclusion in H1.  auto.
Qed.

Lemma LL1': forall M (conf conf' : configuration M) sce re,
    constructConfig sce re conf = Result (conf') ->
    dom (controlstate conf) = (dom (controlstate conf'))
      /\  (finishedscenarios conf' = sce::nil).
Proof. intros.
split.  Focus 2.    apply termL3 with (e:=re) (conf:=conf). symmetry. auto.
unfold constructConfig in H.
destruct (getScenarioState sce (controlstate conf)).
destruct (transEvMapFunc (stateEvDefInstanceMap M) (Some s, Some (eventDefinition re))).
destruct (findEventInstance re (datastate conf) l).
destruct (createValueEnv (eventArgs e) (eventParams (eventDefinition re)) (eventArguments re)).
destruct (getStep' conf sce e ).
 unfold configTransition in H.
destruct (execAction (extendValEnv (datastate conf) v, nil) (stepActions s0)
            (filter
               (fun e : event_definition =>
                match eventKind e with
                | Internal => true
                | Imported => false
                | Exported => true
                end) (events M))).
destruct v0. inversion H;simpl.
unfold updateControlState.
assert (forall s1, dom s1 = dom (updateScenarioState' sce (pro_state s0) s1)).
intros. induction s1. simpl.

simpl. auto.
  destruct a. simpl.
destruct ( string_dec (scenarioId s2) (scenarioId sce)). simpl.  f_equal. auto. simpl. f_equal. auto.
apply H0.
inversion H. inversion H. inversion H. inversion H. inversion H.  inversion H.
Qed.

Lemma domControlSyncL1: forall M (conf conf' : configuration M) e sce,
    In sce (dom (controlstate conf))
      -> correct_configuration conf
      -> Result conf' = constructConfig sce e conf
      -> (dom (controlstate conf)) = (dom (controlstate conf')).
Proof. intros.
SearchAbout constructConfig.
symmetry in H1. apply LL1' in H1. destruct H1.
auto.
Qed.

Lemma mergeControlInvariant: forall cso cs1 cs2 cs3, (dom cso = dom cs1) -> (dom cs1 = dom cs2)
-> (Result cs3 = mergeControlStateFunc cso cs1 cs2)-> (dom cso) = (dom cs3).
Proof. intros. generalize dependent cso. generalize dependent cs1. generalize dependent cs2.
induction (cs3). intros.

destruct (cso). auto. destruct cs1.  inversion H. destruct cs2. inversion H0. simpl in H1.
destruct p;destruct p0;destruct p1.    destruct (scenario_dec s s1).  destruct (scenario_dec s s3).  subst.
destruct (mergeControlStateFunc l cs1 cs2). subst.
destruct (string_dec s2 s4). inversion H1.
destruct (string_dec s2 s0). inversion H1.
destruct (string_dec s4 s0). inversion  H1.
inversion H1. inversion H1. inversion H1.  inversion H1.

intros.
destruct cso;destruct cs1;destruct cs2. simpl in H1. inversion H1.
simpl in H1. inversion H1. simpl in H1. inversion H1.
simpl in H1. inversion H1.
inversion H. inversion H.
inversion H0.
simpl in H1.  destruct p; destruct p0; destruct p1.
simpl in H0. simpl in H. inversion H0;subst. inversion H;subst.
destruct (scenario_dec s3 s3).
 remember (mergeControlStateFunc cso cs1 cs2).
 destruct (e0).   destruct (string_dec s2 s4). subst. inversion H1;auto.
 subst. simpl. f_equal.
apply IHl with (cs2:=cs2) (cs1:=cs1);auto.

destruct (string_dec s2 s0).  subst.  inversion H1.  simpl. f_equal.
subst.  apply IHl with (cs2:=cs2) (cs1:=cs1);auto.

destruct (string_dec s4 s0).
inversion H1.    subst. simpl. f_equal.
apply IHl with (cs2:=cs2) (cs1:=cs1);auto.

inversion H1. inversion H1. inversion H1.
Qed.

Lemma mergeControlSceInvariant: forall cso cs1 cs2 cs3 sce, In sce (dom cso) -> (dom cso = dom cs1) -> (dom cs1 = dom cs2)
-> Result cs3 = mergeControlStateFunc cso cs1 cs2 -> getScenarioState sce (cs1) = getScenarioState sce (cs2) ->
 getScenarioState sce (cs1) = getScenarioState sce (cso)
-> getScenarioState sce (cso) = getScenarioState sce (cs3).
Proof. intro cso. induction cso.
- intros. inversion H.
- intros. simpl in H. destruct H.

+ simpl. destruct a.   destruct (string_dec (scenarioId sce) (scenarioId s)).
* simpl in H2. destruct cs1. inversion H2. destruct cs2.  inversion H1.  inversion H1. subst.
inversion H0;subst. simpl. destruct p;destruct p0.  destruct (scenario_dec (fst (s, s1))).
simpl. simpl in H3.  destruct (string_dec (scenarioId s) (scenarioId s)). inversion H0.
destruct (scenario_dec (fst (s, s1)) s2).  inversion e2.
destruct (mergeControlStateFunc cso cs1 cs2).
destruct (string_dec s1 s3). inversion H2. simpl.
destruct (string_dec (scenarioId s) (scenarioId s)).  simpl in H4.
destruct (string_dec (scenarioId s) (scenarioId s)). symmetry;auto.
exfalso;apply n. auto.  exfalso;apply n. auto.  simpl in H4.
destruct (string_dec s1 s0). inversion H2. simpl.
destruct (string_dec (scenarioId s) (scenarioId s)).
destruct (string_dec (scenarioId s) (scenarioId s2)). rewrite e3 in H3. auto.
rewrite <- e2 in n0. simpl in n0. exfalso;apply n0;auto.
exfalso;apply n0;auto.
destruct (string_dec s3 s0).
inversion H2. simpl.
destruct ( string_dec (scenarioId s) (scenarioId s)).  symmetry;auto.
 exfalso;apply n1;auto. inversion H2. inversion H2. inversion H2.    exfalso;apply n;auto. inversion H2.
*
rewrite <- H in n. simpl in n. exfalso;apply n;auto.
+ simpl.  destruct a.     destruct (string_dec (scenarioId sce) (scenarioId s)).
*
simpl in H2. destruct cs1. inversion H2. destruct cs2.  inversion H1.  inversion H1. subst.
inversion H0;subst. simpl. destruct p;destruct p0.  destruct (scenario_dec (fst (s, s1))).
simpl. simpl in H3.
destruct (scenario_dec (fst (s, s1)) s2).
destruct (mergeControlStateFunc cso cs1 cs2).
destruct (string_dec s1 s3). inversion H2. simpl.
 simpl in H4.
destruct (string_dec (scenarioId sce) (scenarioId s)).  symmetry;auto.
exfalso;apply n. auto.   simpl in H4.
destruct (string_dec s1 s0). inversion H2 . simpl.
destruct (string_dec (scenarioId sce) (scenarioId s)).  rewrite e0 in e1.
destruct (string_dec (scenarioId sce) (scenarioId s2)). rewrite e2 in H3. auto.
rewrite <- e1 in n0.   exfalso;apply n0. auto. exfalso;apply n0. auto.
destruct (string_dec (scenarioId sce) (scenarioId s)).
destruct (string_dec s3 s0).
 inversion H2. simpl.
rewrite e2.
destruct (string_dec (scenarioId s) (scenarioId s)). symmetry. auto.
exfalso;apply n1.  auto. inversion H2.
destruct (string_dec s3 s0). inversion H2. simpl.
destruct (string_dec (scenarioId sce) (scenarioId s)).
exfalso;apply n1;auto. simpl in e. exfalso;apply n2;auto. inversion H2. inversion H2. inversion H2.
inversion H2.

* simpl in H4.   destruct (string_dec (scenarioId sce) (scenarioId s)).
rewrite e in n.   exfalso;apply n;auto.
simpl in H2.

destruct cs1. inversion H2. destruct cs2.  inversion H1.  inversion H1. subst.
inversion H0;subst. simpl. destruct p;destruct p0.  destruct (scenario_dec (fst (s, s1)) s).
simpl. simpl in H3.
destruct (scenario_dec (fst (s, s1)) s2). Focus 2. inversion H2. Focus 2. inversion H2.
remember (mergeControlStateFunc cso cs1 cs2).
destruct e1.
destruct (string_dec s1 s3). Focus 3. inversion H2.      inversion H2. simpl.
 simpl in H4.
destruct (string_dec (scenarioId sce) (scenarioId s)).
exfalso;apply n. auto.  destruct (string_dec (scenarioId sce) (scenarioId s2) ).
  rewrite e in e0. rewrite <- e0 in e2. exfalso;apply n0.  auto.
apply IHcso with (cs1:=cs1) (cs2:=cs2). auto. auto. auto. auto. auto. auto.
simpl in H4.
destruct (string_dec s1 s0). inversion H2. simpl.
destruct (string_dec (scenarioId sce) (scenarioId s)).  exfalso;apply n0.  auto.
 destruct (string_dec (scenarioId sce) (scenarioId s2) ).
  rewrite e in e0. rewrite <- e0 in e2. exfalso;apply n0.  auto.
apply IHcso with (cs1:=cs1) (cs2:=cs2). auto. auto. auto. auto. auto. auto.
destruct (string_dec s3 s0).
     destruct (string_dec (scenarioId sce) (scenarioId s)). exfalso;apply n0.  auto.
 destruct (string_dec (scenarioId sce) (scenarioId s2) ). simpl in H6.
rewrite H6 in n3.
   exfalso;apply n3.  auto.
inversion H2. simpl.
destruct (string_dec (scenarioId sce) (scenarioId s)).   exfalso;apply n0.  auto.
apply IHcso with (cs1:=cs1) (cs2:=cs2). auto. auto. auto. auto. auto. auto. inversion H2.

Qed.

Lemma mergeControlSceInvariant': forall M (config config1 config2 config3 : configuration M)
 sce, dom (controlstate config) = dom (controlstate config1) ->
dom (controlstate config1) = dom (controlstate config2)->
In sce (dom (controlstate config)) ->
 Result config3 = mergeConfigFunc config config1 config2
-> getScenarioState sce ( (controlstate config1)) = getScenarioState sce ( (controlstate config2))
-> getScenarioState sce (( (controlstate config1))) = getScenarioState sce (( (controlstate config)))
-> getScenarioState sce ( (controlstate config)) = getScenarioState sce ( (controlstate config3)).
Proof. intros.
unfold mergeConfigFunc in H2.
destruct (mergeDataStateFunc (datastate config) (datastate config1) (datastate config2) ).
remember (mergeControlStateFunc (controlstate config) (controlstate config1) (controlstate config2)).
destruct e.
inversion H2;subst. simpl.
apply mergeControlSceInvariant with (cs1:=controlstate config1) (cs2:=controlstate config2);auto.

inversion H2. inversion H2.
Qed.

Lemma domMergeConfig1: forall v v1 v2,  (exists v3, Result (v3) =
mergeControlStateFunc (v) (v1) (v2)) ->
 dom v = dom v1.
Proof.
Print mergeControlStateFunc. intro v.
induction v.
intros. destruct H.  destruct v1. auto.
simpl in H.
inversion H.
intros. destruct H. destruct v1. simpl in H.  destruct a. inversion H.
destruct v2. simpl in H. destruct a;destruct p. inversion H.
simpl in H.
 destruct a. destruct p.  destruct p0.
destruct (scenario_dec s s1).
destruct (scenario_dec s s3). subst.
remember (mergeControlStateFunc v v1 v2).
destruct e. simpl. f_equal.
apply IHv with (v2:=v2);auto.
exists v0;auto.
inversion H. inversion H.  inversion H.
Qed.

Lemma domMergeConfig2: forall v v1 v2,  (exists v3, Result (v3) =
mergeControlStateFunc (v) (v1) (v2)) ->
 dom v = dom v2.
Proof.
Print mergeControlStateFunc. intro v.
induction v.
intros. destruct H.  destruct v1. destruct v2.  auto.
simpl in H.
inversion H.
intros. simpl in H.  inversion H.
intros.
destruct H. destruct v1. simpl in H.  destruct a. inversion H.
destruct v2. simpl in H. destruct a;destruct p. inversion H.
simpl in H.
 destruct a. destruct p.  destruct p0.
destruct (scenario_dec s s1).
destruct (scenario_dec s s3). subst.
remember (mergeControlStateFunc v v1 v2).
destruct e. simpl. subst. f_equal.
apply IHv with (v1:=v1);auto.
exists v0;auto.
inversion H. inversion H.  inversion H.
Qed.

Lemma domMergeConfig: forall v v1 v2,  (exists v3, Result (v3) =
mergeControlStateFunc (v) (v1) (v2)) ->
 dom v = dom v1 /\ dom v = dom v2.
Proof. intros. split. apply domMergeConfig1 with v2. auto.
     apply domMergeConfig2 with v1. auto.
Qed.

Lemma mergeConfigFuncCSNoChange: forall M (conf conf1 conf2 : configuration M) v,
    Result v = mergeConfigFunc' conf conf1 conf2 ->
    dom (controlstate conf) = dom (controlstate v).
Proof.
  intros.
  unfold mergeConfigFunc' in H.
  remember ( mergeDataStateFunc (datastate conf) (datastate conf1) (datastate conf2)).
  destruct e;inversion H.
  remember (  mergeControlStateFunc (controlstate conf) (controlstate conf1)
                                    (controlstate conf2)).
  destruct e;inversion H;auto. simpl.
  pose proof domMergeConfig.
  assert (dom (controlstate conf) = dom (controlstate conf1) /\ dom (controlstate conf) = dom (controlstate conf2)).
  apply H0. exists v1;auto.
  destruct H3.

  pose proof mergeControlInvariant.
  apply H5 with (cs1:=(controlstate conf1)) (cs2:=(controlstate conf2));auto.
  rewrite H3 in H4;auto.
Qed.

Lemma domMerge: forall  originconf conf' conf'',  (exists rconf,  Result (rconf) = mergeControlStateFunc originconf conf' conf'')
-> (dom ( originconf)) = (dom ( conf')) /\ (dom ( originconf)) = (dom ( conf'')).
Proof.   intros. apply domMergeConfig. auto.
Qed.

Lemma domMerge': forall M (originconf conf' conf'' : configuration M),  (exists rconf,  Result (rconf) = mergeConfigFunc' originconf conf' conf'')
-> (dom (controlstate originconf)) = (dom (controlstate conf')) /\ (dom (controlstate originconf)) = (dom (controlstate conf'')).
Proof.   intros. destruct H. unfold mergeConfigFunc' in H.
destruct (mergeDataStateFunc (datastate originconf) (datastate conf') (datastate conf'') ).
Focus 2. inversion H.
remember (mergeControlStateFunc (controlstate originconf) (controlstate conf') (controlstate conf'')).
destruct e.
apply    domMerge. exists v0. auto. inversion H.
Qed.

Lemma appInclu
     : forall (A : Type) (l1 l2 l : list A),
    incl l1 l -> incl l2 l -> incl ( l1 ++ l2 ) l.
Proof. intros A l1;induction l1.
-intros. simpl;auto.
- intros. simpl.   unfold incl.
  intros. destruct H1. subst. unfold incl in H. apply H;auto. left;auto.
  apply in_app_iff in H1. destruct H1.
  unfold incl in H. apply H. right;auto.

  unfold incl in H0. apply H0. auto.
Qed.

Lemma incluSyncL1: forall M (conf conf' : configuration M) sce e,   In sce (dom (controlstate conf)) -> correct_configuration conf  -> Result conf' = constructConfig sce e conf  ->
scenarioInclusion conf'.
Proof. intros. destruct H0.  unfold scenarioInclusion. unfold scenarioInclusion in inclusion.
       symmetry in H1. apply LL1' in H1. destruct H1. rewrite H1.    apply inclInvariant.
    unfold incl. intros. destruct H2. rewrite <- H0;auto. unfold not. intros. inversion H2.
Qed.

(*aux lemma for proving incluSyncL4*)
Lemma incluSyncL2: forall M (rconf originconf conf' conf'' : configuration M),   Result (rconf) = mergeConfigFunc' originconf conf' conf''
/\ scenarioInclusion originconf /\ scenarioInclusion conf' /\ scenarioInclusion conf'' -> scenarioInclusion rconf.

Proof.  intros. destruct H. remember H. clear Heqe.
apply mergeConfigFuncCSNoChange in H. assert ( (dom (controlstate originconf)) = (dom (controlstate conf')) /\ (dom (controlstate originconf)) = (dom (controlstate conf''))).
 apply domMerge'. exists rconf. auto.

repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H
            end.

unfold  scenarioInclusion.
rewrite <- H.
unfold mergeConfigFunc' in e.
destruct ( mergeDataStateFunc (datastate originconf)
        (datastate conf') (datastate conf'')).
remember (mergeControlStateFunc (controlstate originconf) (controlstate conf') (controlstate conf'')).
destruct e0;inversion e;auto.  simpl.
destruct (mergeControlStateFunc (controlstate originconf) (controlstate conf') (controlstate conf'')).
Focus 2. inversion Heqe0. Focus 2.   inversion e.

destruct (mergeList' (raisedevents conf') (raisedevents conf'') raisedEvent_dec).
destruct (mergeList' (exportedevents conf') (exportedevents conf'') raisedEvent_dec).
inversion e. simpl.
Check mergeInclu.
SearchAbout incl.
apply appInclu;auto. unfold scenarioInclusion in H3. rewrite H1;auto.  rewrite H2;auto.
apply appInclu;auto. unfold scenarioInclusion in H3. rewrite H1;auto.  rewrite H2;auto.
apply appInclu;auto. unfold scenarioInclusion in H3. rewrite H1;auto.  rewrite H2;auto.

Qed.

(*aux lemma for proving incluSync*)
Lemma incluSyncL4: forall M v (conf : configuration M) e  w,
    correct_configuration conf
      -> (forall conf', In conf' v
            -> (exists sce,
                   In sce (dom (controlstate conf))
                     /\  Result (conf')=  constructConfig sce e conf))
      -> Some (w) =  innerCombineFunc'''' conf v
      -> scenarioInclusion w.
Proof.
intros ? v. induction v.
- intros. simpl in H1. inversion H1.
- intros. simpl in H1.
  destruct v.
 remember (mergeConfigFunc' conf conf a).
  destruct e0;inversion H1;auto. subst.
  pose proof incluSyncL2.
  apply incluSyncL2 with (originconf:=conf) (conf':=conf) (conf'':=a);auto. split;auto.
  split. destruct H;auto. split.  destruct H;auto.
destruct H0 with a. left;auto.
destruct H3.
apply incluSyncL1 with (e:=e) (conf:=conf) (sce:=x);auto.
remember (innerCombineFunc'''' conf (c :: v)).
destruct o;inversion H1. clear H3.
remember (mergeConfigFunc' conf a c0).
destruct e0;inversion H1. subst.
apply IHv with (e:=e) in Heqo;auto.
Focus 2.
intros.
apply H0. right;auto.
 pose proof incluSyncL2.
  apply incluSyncL2 with (originconf:=conf) (conf':=a) (conf'':=c0);auto. split;auto.
  split. destruct H;auto. split.  destruct H0 with a;auto.
left;auto. destruct H3.
apply incluSyncL1 with (e:=e) (conf:=conf) (sce:=x);auto.
auto.
(*remember (innerCombineFunc'''' conf v). destruct o;inversion H1;auto. remember (mergeConfigFunc' conf c a). destruct e0;inversion H1;auto;subst.
  simpl in H0. destruct H0 with a. left. auto. destruct H2.
  SearchAbout mergeConfigFunc'.
  pose proof incluSyncL2.
  apply incluSyncL2 with (originconf:=conf) (conf':=c) (conf'':=a);auto. split;auto.
  split. destruct H;auto. split.

  apply IHv with (e:=e) in Heqo;auto.
  apply incluSyncL1 with (e:=e) (conf:=conf) (sce:=x);auto.
  remember (mergeConfigFunc' conf conf a).
  destruct e0;inversion H1;auto. subst.
  pose proof incluSyncL2.
  apply incluSyncL2 with (originconf:=conf) (conf':=conf) (conf'':=a);auto. split;auto.
  split. destruct H;auto. split.  destruct H;auto.
destruct H0 with a. left;auto.
destruct H4.
  apply incluSyncL1 with (e:=e) (conf:=conf) (sce:=x);auto.
*)
Qed.

(*aux lemma for proving termL5*)
Lemma incluSync: forall M (conf conf' : configuration M) e,  correct_configuration conf -> synchrony conf conf' e -> scenarioInclusion conf'.
Proof. intros.
unfold synchrony in H0.
   repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.

unfold combineFunc in H1.

remember (constructConfigList (dom (controlstate conf)) e conf).
destruct e0. destruct v. inversion H1.

Focus 2. inversion H1. remember (innerCombineFunc'''' conf (c :: v)).
destruct o;inversion H1.  unfold removeEventFromConf. unfold scenarioInclusion.
simpl. pose proof incluSyncL4.
assert (scenarioInclusion c0).
apply H2 with (v:=(c::v)) (conf:=conf) (e:=e);auto. intros.
pose proof termL2.
unfold constructConfigList in Heqe0.
assert (exists sce : scenario,
    In sce (filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                  scenario_dec)) /\ Result conf'0 = constructConfig sce e conf).
apply H5 with (lst:=c::v);auto.
destruct H6. destruct H6. exists x. split;auto. apply filter_In in H6.
destruct H6. apply filterL2 in H6;auto.
unfold scenarioInclusion in H4. auto.
Qed.

Lemma uniqSyncL1: forall M (conf conf' : configuration M) e sce,   In sce (dom (controlstate conf)) -> correct_configuration conf  -> Result conf' = constructConfig sce e conf  ->
uniqList (dom (controlstate conf'))
/\ uniqList (finishedscenarios conf').
Proof.  intros. assert (dom (controlstate conf) = dom (controlstate conf')).
symmetry in H1. apply LL1' in H1. destruct H1. auto.
destruct H0. split. rewrite <- H2. auto.
symmetry in H1. apply LL1' in H1.
destruct H1. rewrite H1.  constructor. constructor. unfold not. intros. inversion H3.
Qed.

Lemma uniqSyncL2: forall M (rconf originconf conf' conf'' : configuration M), correct_configuration originconf
-> uniqList (dom (controlstate conf'))
-> uniqList (finishedscenarios conf')
-> uniqList (dom (controlstate conf''))
-> uniqList (finishedscenarios conf'')
->  Result (rconf) = mergeConfigFunc' originconf conf' conf''
-> (forall i : scenario, In i (finishedscenarios conf') -> ~ In i (finishedscenarios conf''))
-> (forall i : scenario, In i (finishedscenarios conf'') -> ~ In i (finishedscenarios conf'))
-> uniqList (dom (controlstate rconf))
/\ uniqList (finishedscenarios rconf).
Proof. intros.
split.
- assert ( dom (controlstate originconf) = dom (controlstate conf') /\
       dom (controlstate originconf) = dom (controlstate conf'')).
apply     domMerge'. exists rconf. auto.

assert ((dom (controlstate rconf) = (dom (controlstate conf')))).
destruct H7.

apply mergeConfigFuncCSNoChange in H4;auto. rewrite H4 in H7;auto.
destruct H7. rewrite H8;auto.

- unfold mergeConfigFunc' in H4.
destruct (mergeDataStateFunc (datastate originconf) (datastate conf') (datastate conf'')).
destruct (mergeControlStateFunc (controlstate originconf) (controlstate conf') (controlstate conf'')).
inversion H4. simpl.
Focus 2. inversion H4. Focus 2. inversion H4.
clear H8.
SearchAbout uniqList.
apply uniqApp';auto.
Qed.

Lemma finishedscenarioIn: forall lst e M (conf : configuration M) v i c,
    uniqList lst ->
    incl lst (dom (controlstate conf)) ->
    Result v = constructConfigList' lst e conf ->
    Some c = innerCombineFunc'''' conf v ->
    In i (finishedscenarios c) ->
    ~ In i (finishedscenarios conf) ->
    In i lst.
Proof. intro lst;induction lst.
       - intros. simpl in H1. inversion H1;subst. simpl in H2.  inversion H2.
       - intros. simpl in H1.
         remember (constructConfig a e conf).
         destruct e0;inversion H1. clear H6.
         remember (constructConfigList' lst e conf).
         destruct e0;inversion H1. subst.
         clear H1.
         simpl in H2.
         destruct v1.
           remember (mergeConfigFunc' conf conf v0).
         destruct e0;inversion H2. subst.

          unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H2;subst. inversion H5. rewrite H6 in H3. simpl in H3. clear H5.
         clear H6. clear H2.
         apply in_app_iff in H3. destruct H3.
         contradiction.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst. left;auto.
         inversion H1.
         inversion H5.
         remember (innerCombineFunc'''' conf (c0 :: v1)).
         destruct o;inversion H2;subst.
         clear H5.
         remember (mergeConfigFunc' conf v0 c1).
         destruct e0;inversion H2. subst. clear H2.
         unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate v0) (datastate c1));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate v0) (controlstate c1));inversion H2;subst. simpl in H3. clear Heqe2.
         clear H2.
         apply in_app_iff in H3. destruct H3.
         Focus 2.
         apply IHlst with (e:=e) (i:=i) in Heqo;auto.
         Focus 2. inversion H;auto. Focus 2.
         unfold incl. unfold  incl in H0.
         intros.    apply H0;auto. right;auto.
         right;auto.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst. left;auto.
         inversion H1.
         (*remember (innerCombineFunc'''' conf v1).
         destruct o;inversion H2;subst. clear H5.
         remember (mergeConfigFunc' conf c0 v0).
         destruct e0;inversion H2. subst. clear H2.
         unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate c0) (datastate v0));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate c0) (controlstate v0));inversion H2;subst. simpl in H3. clear Heqe2.
         clear H2.
         apply in_app_iff in H3. destruct H3.
         apply IHlst with (e:=e) (i:=i) in Heqo;auto.
         Focus 2. inversion H;auto. Focus 2.
         unfold incl. unfold  incl in H0.
         intros.    apply H0;auto. right;auto.
         right;auto.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst. left;auto.
         inversion H1.
         clear H5.
         remember (mergeConfigFunc' conf conf v0).
         destruct e0;inversion H2. subst.

          unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H2;subst. inversion H5. rewrite H6 in H3. simpl in H3. clear H5.
         clear H6. clear H2.
         apply in_app_iff in H3. destruct H3.
         contradiction.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst. left;auto.
         inversion H1.
      inversion H5. *)
Qed.

Lemma termL2': forall scs M (conf : configuration M) e lst  sce, constructConfigList' scs e conf = Result lst ->
 In sce scs -> exists conf', Result conf' = constructConfig sce e conf.
Proof.  intro lst. induction lst.
- intros. inversion H0.
- intros. destruct H0. simpl in H.
remember (constructConfig a e conf). destruct e0.

remember (constructConfigList' lst e conf).

destruct e0. subst. exists v;auto. inversion H. inversion H.
simpl in H.
remember ( constructConfig a e conf ).
destruct e0;inversion H. clear H2.
remember (constructConfigList' lst e conf ).
destruct e0;inversion H. subst.

symmetry in Heqe1. apply IHlst  with (sce:=sce) in Heqe1 ;auto.

Qed.

Lemma finishedscenarioInAll: forall lst e M (conf : configuration M) v i c,
    uniqList lst ->
    incl lst (dom (controlstate conf)) ->
    Result v = constructConfigList' lst e conf ->
    Some c = innerCombineFunc'''' conf v ->
     In i (finishedscenarios c) ->
    (In i lst \/ In i (finishedscenarios conf)).
Proof. intro lst;induction lst.
       - intros. simpl in H1. inversion H1;subst. simpl in H2.  inversion H2.
       - intros. simpl in H1.
         remember (constructConfig a e conf).
         destruct e0;inversion H1. clear H5.
         remember (constructConfigList' lst e conf).
         destruct e0;inversion H1. subst.
         clear H1.
         simpl in H2.

         destruct v1.
         remember (mergeConfigFunc' conf conf v0).
         destruct e0;inversion H2. subst.
         unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H2;subst. inversion H4. rewrite H5 in H3;simpl in H3.  clear Heqe2.
         clear H4. clear H5.  clear H2.

         apply in_app_iff in H3. destruct H3.
         right;auto.
         SearchAbout finishedscenarios.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst. left;left;auto.
inversion H1.          inversion H4.
         remember (innerCombineFunc'''' conf (c0 :: v1)).
           destruct o;inversion H2;subst. clear H4.
         remember (mergeConfigFunc' conf v0 c1).
         destruct e0;inversion H2. subst. clear H2.
         unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate v0) (datastate c1));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate v0) (controlstate c1));inversion H2;subst. simpl in H3. clear Heqe2.
         clear H2.
         apply in_app_iff in H3. destruct H3.
         Focus 2.
          apply IHlst with (e:=e) (i:=i) in Heqo;auto.

          destruct Heqo.
          left. right;auto. right;auto. inversion H;auto.

         unfold incl. unfold  incl in H0.
         intros.    apply H0;auto. right;auto.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst.
         left;auto. left;auto. inversion H1.
         (*remember (innerCombineFunc'''' conf v1).
         destruct o;inversion H2;subst. clear H4.
         remember (mergeConfigFunc' conf c0 v0).
         destruct e0;inversion H2. subst. clear H2.
         unfold mergeConfigFunc' in Heqe2.
         destruct (mergeDataStateFunc (datastate conf) (datastate c0) (datastate v0));inversion Heqe2. destruct (mergeControlStateFunc (controlstate conf) (controlstate c0) (controlstate v0));inversion H2;subst. simpl in H3. clear Heqe2.
         clear H2.

         apply in_app_iff in H3. destruct H3.
         apply IHlst with (e:=e) (i:=i) in Heqo;auto. destruct Heqo.
         left. right;auto. right;auto. inversion H;auto.

         unfold incl. unfold  incl in H0.
         intros.    apply H0;auto. right;auto.
         apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst.
         left;auto. left;auto. inversion H1.
         clear H4.

          unfold mergeConfigFunc' in H2.
         destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion H2. destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H2;subst. simpl in H3. clear H2.
         clear H4.

         apply in_app_iff in H3. destruct H3. right;auto.

          apply termL3 in Heqe0. rewrite Heqe0 in H1. destruct H1. subst.
         left;auto. left;auto. inversion H1.
Qed. *)

(*(forall conf', In conf' v -> (exists sce, In sce lst /\  Result (conf')=  constructConfig sce e conf ))
->*)
Qed.

Lemma uniqSyncL3: forall M (conf : configuration M) lst v e  w,
    correct_configuration conf ->
    uniqList lst ->
    incl lst (dom (controlstate conf)) ->

Result v =
          constructConfigList'
            lst e
            conf ->
(forall sce, In sce lst -> ~ In sce (finishedscenarios conf)) ->
Some(w) =  innerCombineFunc'''' conf v ->  uniqList (dom (controlstate w))
/\ uniqList (finishedscenarios w).
Proof.
intros ? ? lst. induction lst.
- intros. simpl in H2. inversion H2;subst. simpl in H4. inversion H4.
- intros. simpl in H2.
  remember (constructConfig a e conf).
  destruct e0;inversion H2. clear H6.
  remember (constructConfigList' lst e conf).
  destruct e0;inversion H2;subst. clear H2.
  simpl in H4.
  destruct v1.
   remember (mergeConfigFunc' conf conf v0).
  destruct e0;inversion H4;auto. subst.
  split.
  pose proof mergeConfigFuncCSNoChange.
  rewrite <- mergeConfigFuncCSNoChange with (conf:= conf) (conf1:=conf) (conf2:=v0) (v:=v);auto. destruct H;auto.
  unfold mergeConfigFunc' in Heqe2.
  destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion Heqe2.
  destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H5. simpl.
  clear H6. clear H4;clear H5. clear Heqe2.
  apply uniqApp';auto.
  destruct H;auto.
  apply termL3 in Heqe0. rewrite Heqe0. constructor. constructor.
  unfold not. intros. inversion H2.
  intros.
  apply termL3 in Heqe0. rewrite Heqe0. unfold not. intros.
  destruct H4;subst. Focus 2. inversion H4.
  destruct H3 with (sce:=i);auto. left;auto.
  intros.
  apply H3;auto.
  apply termL3 in Heqe0. rewrite Heqe0 in H2.
  destruct H2. subst. left;auto. inversion H2.

  remember (innerCombineFunc'''' conf (c :: v1)).
   destruct o;inversion H4.
  remember (mergeConfigFunc' conf v0 c0 ).
  destruct e0;inversion H4;subst. clear H4;clear H5.
  split.
  pose proof mergeConfigFuncCSNoChange.
  apply H2 in Heqe2. rewrite <- Heqe2. destruct H;auto.
  unfold mergeConfigFunc' in Heqe2.
  remember (mergeDataStateFunc (datastate conf) (datastate v0) (datastate c0)).
  destruct e0;inversion Heqe2.
  remember ( mergeControlStateFunc (controlstate conf) (controlstate v0) (controlstate c0)).
  destruct e0;inversion H4. simpl.
  apply uniqApp'. Focus 2.
  apply IHlst with (e:=e) in Heqo;auto. Focus 2. inversion H0;auto.
  Focus 2.

  unfold incl. intros. unfold incl in H1. apply H1;auto. right;auto.
  destruct Heqo;auto. intros. apply H3. right;auto.
  apply termL3 in Heqe0;auto. rewrite Heqe0. constructor. constructor. unfold not. intros.
  inversion H2.
  intros.  SearchAbout finishedscenarios. apply termL3 in Heqe0. rewrite Heqe0 in H2.
  destruct H2. subst.  Focus 2. inversion H2.
assert ( ~ In i (finishedscenarios conf)).
  apply H3;auto. left;auto.
 unfold not. intros.
  pose proof finishedscenarioInAll.
  assert (  In i lst \/ In i (finishedscenarios conf)).
  apply H6 with (e:=e) (v:=c::v1) (c:=c0);auto.
  inversion H0;auto.
  unfold incl;intros. unfold incl in H1. apply H1;auto. right;auto.
  destruct H7. inversion H0;subst. contradiction. contradiction.
  intros.
  unfold not;intros.
  apply termL3 in Heqe0.  rewrite Heqe0 in H6. destruct H6. Focus 2.
  inversion H6.   subst.  pose proof finishedscenarioInAll.

  assert (  In i lst \/ In i (finishedscenarios conf)).
  apply H5 with (e:=e) (v:=c::v1) (c:=c0);auto.
  inversion H0;auto.
  unfold incl;intros. unfold incl in H1. apply H1;auto. right;auto.
  destruct H6. inversion H0;subst. contradiction.
  destruct H3 with i. left;auto. auto.
  (*
  remember (innerCombineFunc'''' conf v1).
  destruct o;inversion H4.
  remember (mergeConfigFunc' conf c v0 ).
  destruct e0;inversion H4;subst. clear H4;clear H5.
  split.
  pose proof mergeConfigFuncCSNoChange.
  apply H2 in Heqe2. rewrite <- Heqe2. destruct H;auto.
  unfold mergeConfigFunc' in Heqe2.
  remember (mergeDataStateFunc (datastate conf) (datastate c) (datastate v0)).
  destruct e0;inversion Heqe2.
  remember ( mergeControlStateFunc (controlstate conf) (controlstate c) (controlstate v0)).
  destruct e0;inversion H4. simpl.
  apply uniqApp'.
  apply IHlst with (e:=e) in Heqo;auto. Focus 2. inversion H0;auto.
  Focus 2.

  unfold incl. intros. unfold incl in H1. apply H1;auto. right;auto.
  destruct Heqo;auto. intros. apply H3. right;auto.
  apply termL3 in Heqe0;auto. rewrite Heqe0. constructor. constructor. unfold not. intros.
  inversion H2.
  intros.
  remember Heqe0. clear Heqe5.
  apply termL3 in Heqe0;auto. rewrite Heqe0.
  unfold not. intros. destruct H6;inversion H6. subst. clear H7.
  pose proof finishedscenarioIn. clear Heqe2. clear H4.
  apply H5 with (i:=i) (c:=c) in Heqe1;auto. inversion H0;subst. contradiction.
  inversion H0;auto. unfold incl. unfold incl in H1. intros.
  apply H1;auto. right;auto. apply H3. left;auto.
  intros. clear H5. clear H4. clear Heqe2.
  apply termL3 in Heqe0. rewrite Heqe0 in H2. destruct H2.
  subst.
  assert ( ~ In i (finishedscenarios conf)).
  apply H3;auto. left;auto.
  unfold not. intros.
  pose proof finishedscenarioInAll.
  assert (  In i lst \/ In i (finishedscenarios conf)).
  apply H5 with (e:=e) (v:=v1) (c:=c);auto.
  inversion H0;auto.
  unfold incl;intros. unfold incl in H1. apply H1;auto. right;auto.
  destruct H6. inversion H0;subst. contradiction. contradiction. inversion H2.
  remember (mergeConfigFunc' conf conf v0).
  destruct e0;inversion H4;auto. subst.
  split.
  SearchAbout (mergeConfigFunc').
  pose proof mergeConfigFuncCSNoChange.
  rewrite <- mergeConfigFuncCSNoChange with (conf:= conf) (conf1:=conf) (conf2:=v0) (v:=v);auto. destruct H;auto.
  unfold mergeConfigFunc' in Heqe2.
  destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate v0));inversion Heqe2.
  destruct (mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate v0));inversion H6. simpl.
  clear H7. clear H6. clear H4;clear H5. clear Heqe2.
  SearchAbout uniqList.
  apply uniqApp';auto.
  destruct H;auto.
  apply termL3 in Heqe0. rewrite Heqe0. constructor. constructor.
  unfold not. intros. inversion H2.
  intros.
  apply termL3 in Heqe0. rewrite Heqe0. unfold not. intros.
  destruct H4;subst. Focus 2. inversion H4.
  destruct H3 with (sce:=i);auto. left;auto.
  intros.
  apply H3;auto.
  apply termL3 in Heqe0. rewrite Heqe0 in H2.
  destruct H2. subst. left;auto. inversion H2. *)
Qed.

Lemma filterUniq: forall A (l:list A) (f:A -> bool),
    uniqList l ->
    uniqList (@filter A f l).
Proof. intros A l;induction l.
       - intros. simpl. constructor.
       - intros. simpl.
         destruct (f a).
         inversion H;subst.
         constructor.
         apply IHl;auto.
         SearchAbout filter.
         unfold not;intros;apply H3.
         apply filter_In in H0. destruct H0;auto.
         apply IHl;inversion H;subst;auto.
Qed.

Lemma uniqSync: forall M (conf conf' : configuration M) e,  correct_configuration conf -> synchrony conf conf' e -> uniqList (dom (controlstate conf'))
/\ uniqList (finishedscenarios conf').
Proof.  intros.
unfold synchrony in H0.
   repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.

unfold combineFunc in H1. unfold constructConfigList in H1.

remember ( constructConfigList'
           (filter
              (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
              (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec)) e
           conf).
destruct e0;inversion H1.  destruct v;inversion H3.  clear H3. clear H1.

destruct v.
remember (mergeConfigFunc' conf conf c).
destruct e0;inversion H4.
unfold removeEventFromConf;simpl.
split.
apply mergeConfigFuncCSNoChange in Heqe1. rewrite <- Heqe1.
destruct H;auto.
unfold mergeConfigFunc' in Heqe1.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate c));inversion Heqe1.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate conf)
                                 (controlstate c));inversion H3;auto.
simpl.

apply uniqApp';auto.
destruct H;auto.

pose proof termL2.

assert (exists sce : scenario, In sce (filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                  scenario_dec)) /\ Result c = constructConfig sce e conf).
apply H1 with (lst:=c::nil);auto. split;auto. left;auto.
destruct H6. destruct H6.
apply termL3 in H7. rewrite H7. constructor. constructor. unfold not. intros.
inversion H8.
intros.

pose proof termL2.

assert (exists sce : scenario, In sce (filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                  scenario_dec)) /\ Result c = constructConfig sce e conf).
apply H6 with (lst:=c::nil);auto. split;auto. left;auto.
destruct H7.
destruct H7.
apply filter_In in H7.
destruct H7.
unfold not;intros.
apply filterL1 in H7.
apply termL3 in H8. rewrite H8 in H10. destruct H10. subst. contradiction.
inversion H10.
intros. unfold not;intros.

pose proof termL2.

assert (exists sce : scenario, In sce (filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                  scenario_dec)) /\ Result c = constructConfig sce e conf).
apply H7 with (lst:=c::nil);auto. split;auto. left;auto.
destruct H8.
destruct H8.
apply filter_In in H8.
destruct H8.
apply filterL1 in H8.
apply termL3 in H9. rewrite H9 in H1. destruct H1. subst. contradiction.
inversion H1.
remember (c0 :: v).

remember (innerCombineFunc'''' conf l).
destruct o;inversion H4;subst.
remember ( mergeConfigFunc' conf c c1).
destruct e0;inversion H2;subst.
unfold removeEventFromConf;simpl.

pose proof domMerge'.
assert (dom (controlstate conf) = dom (controlstate c) /\
        dom (controlstate conf) = dom (controlstate c1)).
apply H1;auto. exists v0;auto.
destruct H3.
apply uniqSyncL2 with (originconf:=conf) (conf':=c) (conf'':=c1) ;auto.
rewrite <- H3.  destruct H;auto.
Focus 2. rewrite <- H5. destruct H;auto.
Focus 2.
pose proof termL2.
pose proof uniqSyncL3.
pose proof termL2.
assert (exists sce : scenario, In sce (filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                           scenario_dec))  /\ Result c = constructConfig sce e conf).
apply H8 with (lst:=(c :: c0 :: v));auto.
split;auto. left;auto.
destruct H9. destruct H9.

apply uniqSyncL1 in H10;auto. Focus 2.
apply filter_In in H9. destruct H9. apply filterL2 in H9;auto.  destruct H10;auto.
 apply filter_In in H9. destruct H9.

assert (uniqList (dom (controlstate c1)) /\ uniqList (finishedscenarios c1)).

 remember ((filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                           scenario_dec))).
 destruct l. simpl in Heqe0. inversion Heqe0.
 apply H7 with (conf:=conf) (lst:=l) (v:=(c0::v)) (e:=e);auto.
 assert (uniqList ( filter
           (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
           (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec))).
 SearchAbout filter. apply filterUniq;auto.
 SearchAbout filterList. apply uniqListFilter;destruct H;auto.
 rewrite <- Heql in H13. inversion H13;subst;auto.
 unfold incl;intros.
 assert (In a (s::l)). right;auto. rewrite  Heql in H14.
 SearchAbout filter. apply filter_In in H14. destruct H14. apply filterL2 in H14;auto.
 simpl in Heqe0.
 destruct (constructConfig s e conf );inversion Heqe0.
 remember (constructConfigList' l e conf).
 destruct e0;inversion H14. auto.
 intros.

 assert (In sce (s::l)). right;auto. rewrite  Heql in H14.
 apply filter_In in H14. destruct H14. apply filterL1 in H14;auto.
 destruct H13;auto.

 remember ((filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                           scenario_dec))).
 destruct l. simpl in Heqe0. inversion Heqe0.
 simpl in Heqe0.
 remember (constructConfig s e conf).
 destruct e0;inversion Heqe0.
 destruct (constructConfigList' l e conf);inversion Heqe0. subst.
 apply termL3 in Heqe2. rewrite Heqe2. constructor. constructor. unfold not;intros. inversion H6.
 intros.
 unfold not;intros.
  remember ((filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                           scenario_dec))).
 destruct l. simpl in Heqe0. inversion Heqe0.
 simpl in Heqe0.
 remember (constructConfig s e conf).
 destruct e0;inversion Heqe0.
clear H9.  remember (constructConfigList' l e conf). destruct e0;inversion Heqe0. subst.
apply termL3 in Heqe2. rewrite Heqe2 in H6. destruct H6. subst.
Focus 2. inversion H6.
pose proof finishedscenarioIn.
apply H6 with (lst:=l) (e:=e) (i:=i) in Heqo;auto.
assert (uniqList ( filter
           (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
           (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec))).
SearchAbout filter.
apply filterUniq.
SearchAbout filterList. apply uniqListFilter;destruct H;auto.
rewrite <- Heql in H8. inversion H8;subst. contradiction.
assert (uniqList ( filter
           (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
           (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec))).
apply filterUniq.
 apply uniqListFilter;destruct H;auto.
 rewrite <- Heql in H8. inversion H8;subst;auto.
 unfold incl;intros.
 assert (In a (i::l)). right;auto.
rewrite Heql in H9. apply filter_In in H9. destruct H9. apply filterL2 in H9;auto.
assert (In i (i::l)). left;auto.
rewrite Heql in H8. apply filter_In in H8. destruct H8. apply filterL1 in H8;auto.
intros.
unfold not;intros.

 remember ((filter
               (fun x : scenario =>
                inList event_definition_dec (eventDefinition e) (alphabet x))
               (filterList (finishedscenarios conf) (dom (controlstate conf))
                           scenario_dec))).
 destruct l. simpl in Heqe0. inversion Heqe0.
 simpl in Heqe0.
 remember (constructConfig s e conf).
 destruct e0;inversion Heqe0.
 remember(constructConfigList' l e conf). destruct e0;inversion Heqe0. subst.
 clear Heqe0.  apply termL3 in Heqe2. rewrite Heqe2 in H7. destruct H7;subst.  Focus 2. inversion H7.
clear H9. pose proof finishedscenarioIn.
 apply H7 with (lst:=l) (e:=e) (i:=i) in Heqo;auto.
assert (uniqList ( filter
           (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
           (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec))).
apply filterUniq.
 apply uniqListFilter;destruct H;auto.
rewrite <- Heql in H8. inversion H8;subst. contradiction.
assert (uniqList ( filter
           (fun x : scenario => inList event_definition_dec (eventDefinition e) (alphabet x))
           (filterList (finishedscenarios conf) (dom (controlstate conf)) scenario_dec))).
apply filterUniq.
 apply uniqListFilter;destruct H;auto.
 rewrite <- Heql in H8. inversion H8;subst;auto.
 unfold incl;intros.
 assert (In a (i::l)). right;auto.
rewrite Heql in H9. apply filter_In in H9. destruct H9. apply filterL2 in H9;auto.
assert (In i (i::l)). left;auto.
rewrite Heql in H8. apply filter_In in H8. destruct H8. apply filterL1 in H8;auto.

Qed.

(*
(*aux lemma*)
Lemma termL3': forall e conf sce conf',  Result conf' = constructConfig sce e conf  ->
 (forall sce', In sce' (finishedscenarios conf) ->In sce'  (finishedscenarios conf')).
Proof.
intros. pose proof termL3.
assert (finishedscenarios conf' = sce :: finishedscenarios conf).
eapply H1. apply H. rewrite H2. simpl; right;auto.
Qed.

(*aux lemma*)
Lemma finishedInvariant: forall e conf lst scs sce, constructConfigList' scs e conf = Result lst
(*-> In sce scs*) -> In sce (finishedscenarios conf)
-> (forall conf', In conf' lst -> In sce (finishedscenarios conf')).
Proof. intros. pose proof termL2'. pose proof termL3'. pose proof termL2.
assert (constructConfigList' scs e conf = Result lst /\ In conf' lst).
split;auto. apply H4 in H5. destruct H5.  destruct H5.
eapply H3 in H6. apply H6. auto.
Qed.

(*aux lemma*)
Lemma finishedSceInvariant: forall config config1 config2 config3
 sce, In sce (dom (controlstate config)) ->
(In sce (finishedscenarios config1) \/
In sce (finishedscenarios config2)) ->
 Result config3 = mergeConfigFunc config config1 config2
-> In sce (finishedscenarios config3) .
Proof. intros.
unfold mergeConfigFunc in H1.
destruct (mergeDataStateFunc (datastate config) (datastate config1) (datastate config2)).
destruct (mergeControlStateFunc (controlstate config) (controlstate config1) (controlstate config2)).
inversion H1. simpl. unfold  mergeList'.
apply in_or_app. destruct H0. left. auto.
assert (In sce (finishedscenarios config1) \/ ~(In sce (finishedscenarios config1))).
apply excluded_middle.  destruct H2. left. auto.     right.
SearchAbout filterIn. apply filterIn. auto. auto. inversion H1. inversion H1.
Qed.

 (*aux lemma*)
Lemma finishedInvariantCombine: forall lst conf conf'  sce ,
correct_configuration conf -> In sce (finishedscenarios conf) ->
innerCombineFunc' conf None lst= Result conf' ->
(forall conf', In conf' lst -> In sce (finishedscenarios conf'))
-> In sce (finishedscenarios conf').
Proof. intro lst. induction lst.
- intros. simpl in H1. inversion H1.
-intros. simpl in H1. destruct lst.
+ simpl in H1. apply H2. inversion H1. simpl;left;auto.
+ simpl in H1.
remember ( innerCombineFunc' conf (Some c) lst ).
destruct e.
assert (conf'=a \/ ~(conf'=a)).
apply excluded_middle. destruct H3.
apply H2. rewrite H3. simpl;left;auto. Focus 2. inversion H1.
assert (In sce (finishedscenarios v)).

apply IHlst with (conf:=conf). auto. auto. symmetry;auto.
intros. apply H2. simpl;right;auto.
eapply finishedSceInvariant. Focus 2. right. apply H4. Focus 2. symmetry. apply H1.
destruct H.
 unfold scenarioInclusion in inclusion. unfold incl in inclusion. apply inclusion. auto.
Qed.
*)

Print innerCombineFunc''''.

Lemma finishedInvariantCombine: forall M  v (conf conf' : configuration M)  sce ,

 In sce (finishedscenarios conf) ->
innerCombineFunc'''' conf v = Some conf' ->
 In sce (finishedscenarios conf').
Proof. intros ? v. induction v.
- intros. simpl in H0. inversion H0.
-intros. simpl in H0.
remember (innerCombineFunc'''' conf v ).
destruct o;inversion H0.
remember (mergeConfigFunc' conf a c ).
destruct e;inversion H0. subst.
unfold mergeConfigFunc' in Heqe.
destruct (mergeDataStateFunc (datastate conf) (datastate a) (datastate c) );inversion Heqe.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate a) (controlstate c));inversion H4.
destruct v. Focus 2. inversion H0;subst. simpl. rewrite in_app_iff. right.
apply IHv with (conf:=conf);auto.
remember (mergeConfigFunc' conf conf a ).
destruct e;inversion H0.
subst.
unfold mergeConfigFunc' in Heqe0.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate a) );inversion Heqe0.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate a));inversion H5.
simpl. rewrite in_app_iff. left;auto.
destruct v;inversion H3.

remember (mergeConfigFunc' conf conf a ).
destruct e;inversion H0.
subst.
unfold mergeConfigFunc' in Heqe0.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate a) );inversion Heqe0.
destruct ( mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate a));inversion H5.
simpl. rewrite in_app_iff. left;auto.

remember (mergeConfigFunc' conf conf a ).
destruct e;inversion H0.
subst.
unfold mergeConfigFunc' in Heqe.
destruct (mergeDataStateFunc (datastate conf) (datastate conf) (datastate a) );inversion Heqe.
Focus 2. destruct v;inversion H0. destruct ( mergeControlStateFunc (controlstate conf) (controlstate conf) (controlstate a));inversion H4. destruct v;inversion H0. subst.
simpl. rewrite in_app_iff. left;auto.

Qed.

Lemma finishedInvariantSync: forall e M (conf conf': configuration M) sce,
synchrony conf conf' e ->
In sce (finishedscenarios conf)
-> In sce (finishedscenarios conf').
Proof. intros. unfold synchrony in H.
  repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
unfold combineFunc in H1.

remember (constructConfigList (dom (controlstate conf)) e conf).
destruct e0;inversion H1.
clear H3.
destruct v;inversion H1.
remember (innerCombineFunc'''' conf (c :: v)).
destruct o;inversion H1.
unfold removeEventFromConf.
simpl.
apply finishedInvariantCombine with (v:=c::v) (conf:=conf);auto.

(*eapply finishedInvariantCombine. apply H. auto. apply H4. intros.
pose proof finishedInvariant. symmetry in Heqe0. unfold constructConfigList in Heqe0.
eapply H6. apply Heqe0. auto. auto. inversion H4. *)
Qed.

Lemma domControlSync: forall M (conf conf' : configuration M) e,  synchrony conf conf' e ->  (dom (controlstate conf)) = (dom (controlstate conf')).
Proof. intros.
unfold synchrony in H.
   repeat match goal with
            | [ H: _ /\ _ |- _ ] => destruct H

            end.
unfold combineFunc in H0.
remember (constructConfigList (dom (controlstate conf)) e conf).

destruct e0;inversion H0. destruct v;inversion H2.
clear H3. clear H0.

remember (innerCombineFunc'''' conf (c::v)).

destruct o;inversion H2;auto.
unfold removeEventFromConf. simpl.
SearchAbout innerCombineFunc''''.
simpl in Heqo.
destruct v.
 remember (mergeConfigFunc' conf conf c).
  destruct e0;inversion Heqo.
subst.   apply mergeConfigFuncCSNoChange with (conf1:=conf) (conf2:=c);auto.
remember (innerCombineFunc'''' conf (c1 :: v)).
destruct o;inversion Heqo.
clear H3.
remember (mergeConfigFunc' conf c c2).
destruct e0;inversion Heqo. subst.
Check mergeConfigFuncCSNoChange.
  apply mergeConfigFuncCSNoChange with (conf1:=c) (conf2:=c2);auto.

Qed.

Lemma monitorObjNoChangeSync: forall M (conf conf' : configuration M) e,
    synchrony conf conf' e -> M = M.
Proof. reflexivity. Qed.

Lemma scenarioStateNotNone: forall l sce, In sce (dom l) -> getScenarioState sce l <> None.
Proof. intros. induction (l).
- inversion H.
- simpl. destruct a.
destruct (string_dec (scenarioId sce) (scenarioId s)).
unfold not;intros. inversion H0. apply IHl0. simpl in H.
destruct H. rewrite H in n. exfalso. apply n. auto. auto.
Qed.

Lemma mergeDSDom2NoChange: forall ds ds1 ds2 v,
    Result v = mergeDataStateFunc ds ds1 ds2 ->
    dom2 v = dom2 ds.
Proof.
  intro ds;induction ds.
  - intros. simpl in H.
    destruct ds1;inversion H.
    destruct ds2;inversion H;auto.
  -
    intros.
    destruct ds1;inversion H.
    destruct a;destruct p. inversion H1.
    destruct ds2;inversion H1.
    destruct a;destruct p0. destruct p. destruct p;inversion H1.
    destruct a;destruct p1;destruct p;destruct p.
    destruct p0;destruct p.
    destruct (atom_eq_dec a a0);inversion H1.
    destruct (atom_eq_dec a a1);inversion H1.
    destruct (typ_eq_dec t t0);inversion H1.
    destruct (typ_eq_dec t t1);inversion H1.
    remember (mergeDataStateFunc ds ds1 ds2).
    destruct e3;inversion H1.
    subst.
    destruct (range_typ_dec r0 r1).
    subst. inversion H1;simpl.
    f_equal.
    apply IHds with (ds1:=ds1) (ds2:=ds2);auto.
    destruct (range_typ_dec r0 r).
    subst.
    inversion H1;simpl. f_equal.
    apply IHds with (ds1:=ds1) (ds2:=ds2);auto.
    destruct (range_typ_dec r1 r).
    inversion H1;simpl. f_equal.
    apply IHds with (ds1:=ds1) (ds2:=ds2);auto.
    inversion H1.
Qed.

Lemma mergeConfigFuncDom2NoChange: forall M (conf conf1 conf2 : configuration M) v,
  Result v = mergeConfigFunc' conf conf1 conf2 ->
  dom2 (datastate conf) = dom2 (datastate v).
Proof. intros.
       unfold mergeConfigFunc'  in H.
       remember (mergeDataStateFunc (datastate conf) (datastate conf1) (datastate conf2)).       destruct e;inversion H.
       remember (mergeControlStateFunc (controlstate conf) (controlstate conf1)
                                       (controlstate conf2)).
       destruct e;inversion H1.
       simpl.
       pose proof mergeDSDom2NoChange.
       symmetry.
       apply H0 with (ds1:=(datastate conf1)) (ds2:=(datastate conf2));auto.
Qed.

Lemma innerCombineDSDom2: forall M (conf : configuration M) sceList v0  re c,
    correct_configuration conf ->
    incl sceList (dom (controlstate conf)) ->
    Result v0 = constructConfigList' sceList re conf ->
    Some c = innerCombineFunc'''' conf v0 ->

    dom2 (datastate conf) = dom2 (datastate c).
Proof.
  intros ?? sceList;induction sceList.
  - intros.
    simpl in H1. inversion H1;auto. subst. simpl in H2.
    inversion H2.
  - intros.
    simpl in H1.
    remember (constructConfig a re conf ).
    destruct e;inversion H1.
    remember (constructConfigList' sceList re conf).
    destruct e;inversion H1.
    rewrite H5 in H2.
    simpl in H2.
    destruct v1.
    subst.
     remember (mergeConfigFunc' conf conf v).
    destruct e;inversion H2.
    apply mergeConfigFuncDom2NoChange with (conf1:=conf) (conf2:=v);auto.

    remember (innerCombineFunc'''' conf (c0::v1)).
    destruct o;inversion H2.
clear H6.     subst. remember (mergeConfigFunc' conf v c1).
    destruct e;inversion H2.
    subst.
    apply mergeConfigFuncDom2NoChange with (conf1:=v) (conf2:=c1);auto.

Qed.

Lemma syncDSDom2: forall M (conf conf' : configuration M) e,
    correct_configuration conf ->
    synchrony conf conf' e ->
    dom2 (datastate conf) = dom2 (datastate conf').
Proof.
  intros.
  unfold synchrony in H0.
  destruct H0.
  unfold combineFunc in H1.
  remember (constructConfigList (dom (controlstate conf)) e conf ).
  destruct e0;inversion H1.
  destruct v;inversion H3.
  clear H4. clear H1.
  remember (innerCombineFunc'''' conf (c::v)).
  destruct o;inversion H3.
  unfold removeEventFromConf;simpl.
  simpl in Heqo.
  destruct v.
   remember (mergeConfigFunc' conf conf c).
  destruct e0;inversion Heqo.
subst.
  apply mergeConfigFuncDom2NoChange with (conf1:=conf) (conf2:=c);auto.

  remember (innerCombineFunc'''' conf (c1::v)).
  destruct o;inversion Heqo.
clear H4.   unfold removeEventFromConf;simpl.

  remember (mergeConfigFunc' conf c c2).
  destruct e0;inversion Heqo. subst.

  apply mergeConfigFuncDom2NoChange with (conf1:=c) (conf2:=c2);auto.

Qed.


Set Implicit Arguments.

Require Import Bedrock.Platform.Cito.ADT.
Require Import Bedrock.Platform.Cito.RepInv Bedrock.Platform.Cito.WordMap.
Require Import Bedrock.Platform.Cito.Inv.

Lemma starL_in : forall A P x (ls : list A),
  NoDup ls
  -> In x ls
  -> exists ls', (P x * Bags.starL P ls' ===> Bags.starL P ls)
    /\ NoDup ls'
    /\ (forall y, In y ls' <-> y <> x /\ In y ls).
  induction 1; simpl; intuition subst.

  eexists; intuition idtac.
  apply Himp_refl.
  auto.
  congruence.
  tauto.
  congruence.
  auto.

  destruct H1; intuition.
  exists (x0 :: x1); intuition idtac.
  simpl.
  eapply Himp_trans; [ | apply Himp_star_frame; [
    apply Himp_refl | apply H3 ] ].
  generalize dependent (Bags.starL P); intros.
  sepLemma.
  constructor; auto.
  intro.
  apply H5 in H4.
  tauto.
  subst; simpl in *; intuition subst.
  auto.
  apply H5 in H6; intuition.
  simpl in *; intuition subst.
  apply H5 in H6; intuition.
  subst; simpl; tauto.
  right; apply H5.
  auto.
Qed.

Lemma starL_out : forall A P x (ls : list A),
  NoDup ls
  -> In x ls
  -> exists ls', (Bags.starL P ls ===> P x * Bags.starL P ls')
    /\ NoDup ls'
    /\ (forall y, In y ls' <-> y <> x /\ In y ls).
  induction 1; simpl; intuition subst.

  eexists; intuition idtac.
  apply Himp_refl.
  auto.
  congruence.
  tauto.
  congruence.
  auto.

  destruct H1; intuition.
  exists (x0 :: x1); intuition idtac.
  simpl.
  eapply Himp_trans; [ apply Himp_star_frame; [
    apply Himp_refl | apply H3 ] | ].
  generalize dependent (Bags.starL P); intros.
  sepLemma.
  constructor; auto.
  intro.
  apply H5 in H4.
  tauto.
  subst; simpl in *; intuition subst.
  auto.
  apply H5 in H6; intuition.
  simpl in *; intuition subst.
  apply H5 in H6; intuition.
  subst; simpl; tauto.
  right; apply H5.
  auto.
Qed.

Lemma starL_permute : forall A P (ls1 : list A),
  NoDup ls1
  -> forall ls2, NoDup ls2
    -> (forall x, In x ls1 <-> In x ls2)
    -> Bags.starL P ls1 ===> Bags.starL P ls2.
  induction 1.

  inversion_clear 1; simpl; intros.
  apply Himp_refl.
  exfalso; eapply H; eauto.

  intros.
  eapply starL_in in H1.
  Focus 2.
  apply H2.
  simpl; eauto.

  destruct H1; intuition.
  simpl.
  eapply Himp_trans; [ | apply H3 ].
  apply Himp_star_frame; try apply Himp_refl.
  apply IHNoDup; auto.
  intuition.
  simpl in *.
  apply H5; intuition.
  apply H2; auto.
  apply H5 in H4; intuition.
  simpl in *.
  apply H2 in H7.
  intuition.
Qed.


Require Import String List.
Import ListNotations.

Require Import Hemiola.Lib.Index Hemiola.Ex.TopoTemplate.
Require Import Kami.Kami.
Require Import Kami.Ext.Extraction.

Require Import Compiler.HemiolaDeep Compiler.Components Compiler.CompileK.
Require Import MesiDeep MesiComp.

#[global] Existing Instance MesiHOStateIfcFull.
#[global] Instance MesiTopoConfig: TopoConfig :=
  {| hcfg_value_sz := 64;
     hcfg_line_values_lg := 2; (* 32B line *)
     hcfg_children_max_pred := 1 (* max(#children) = 2 *) |}.
#[global] Existing Instance MesiCompExtType.
#[global] Existing Instance MesiCompExtExp.

(***************
 *     Mem     *
 *      |      *
 * --LLC(L2)-- *
 * |         | *
 * L1       L1 *
 ***************)
Definition topo: tree :=
  Node [Node [Node nil; Node nil]].
Definition dtr := fst (tree2Topo topo 0).

(** Cache size: 2^(IndexSz) * 2^(LgWay) * (LineSz = 32B) *)
(* 32KB L1: 2^8 * 2^2 * 32B *)
Definition l1IndexSz: nat := 8.
Definition l1LgWay: nat := 2.
Definition l1NumPRqs: nat := 2.
Definition l1NumCRqs: nat := 4.
Definition l1PredNumVictim: nat := Nat.pred l1NumCRqs.
Definition l1MshrSlotSz: nat := S (Nat.log2 (l1NumPRqs + l1NumCRqs - 1)).
Definition l1Cache (oidx: IdxT): Modules :=
  mesiL1 oidx l1IndexSz l1LgWay l1PredNumVictim.
Definition l1Mshrs (oidx: IdxT): Modules :=
  mshrsL1 oidx l1NumPRqs l1NumCRqs (mshrConflictF (indexSz := l1IndexSz)).

(* 128KB LL: 2^9 * 2^3 * 32B *)
Definition llIndexSz: nat := 9.
Definition llLgWay: nat := 3.
Definition llEDirLgWay: nat := 2.
Definition llNumPRqs: nat := 4.
Definition llNumCRqs: nat := 8.
Definition llPredNumVictim: nat := Nat.pred llNumCRqs.
Definition llMshrSlotSz: nat := S (Nat.log2 (llNumPRqs + llNumCRqs - 1)).
Definition llCache (oidx: IdxT): Modules :=
  mesiLi oidx llIndexSz llLgWay llEDirLgWay llPredNumVictim.
Definition llMshrs (oidx: IdxT): Modules :=
  mshrsLi oidx llNumPRqs llNumCRqs (mshrConflictF (indexSz := llIndexSz)).

Definition kl1c (oidx: IdxT): Modules :=
  ((build_controller_l1
      (H2 := MesiCompLineRW l1LgWay 0)
      l1IndexSz l1NumPRqs l1NumCRqs l1PredNumVictim (existT _ _ (hl1 oidx)))
     ++ l1Cache oidx ++ l1Mshrs oidx)%kami.

Definition kllc (oidx: IdxT): Modules :=
  ((build_controller_li_2_no_ints
      (H2 := MesiCompLineRW llLgWay llEDirLgWay)
      llIndexSz llNumPRqs llNumCRqs llPredNumVictim (existT _ _ (hli topo oidx)))
     ++ llCache oidx ++ llMshrs oidx)%kami.

Definition k: Modules :=
  ((kllc 0~>0) ++ (kl1c 0~>0~>0) ++ (kl1c 0~>0~>1))%kami.

(** Extraction of a compiled Kami design *)

Definition targetM: Kami.Syntax.Modules := k.
Definition targetS := getModuleS targetM.
Definition targetB := ModulesSToBModules targetS.

Time Extraction "./Target.ml" targetB.


From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Thread.
Require Import Configuration.
Require Import Behavior.

Set Implicit Arguments.

Section Simulation.
  Definition SIM := forall (c1_src c1_tgt: Configuration.t), Prop.

  Definition _sim (sim: SIM) (c1_src c1_tgt:Configuration.t): Prop :=
    forall (WF_SRC: Configuration.wf c1_src)
      (WF_TGT: Configuration.wf c1_tgt),
      <<TERMINAL:
        forall (TERMINAL_TGT: Threads.is_terminal (Configuration.threads c1_tgt)),
        exists c2_src,
          <<STEPS_SRC: rtc Configuration.tau_step c1_src c2_src>> /\
          <<TERMINAL_SRC: Threads.is_terminal (Configuration.threads c2_src)>>>> /\
      <<STEP:
        forall e tid c2_tgt
          (STEP_TGT: Configuration.step e tid c1_tgt c2_tgt),
        exists c2_src,
          <<STEP_SRC: Configuration.opt_step e tid c1_src c2_src>> /\
          <<SIM: sim c2_src c2_tgt>>>>
  .

  Lemma _sim_mon: monotone2 _sim.
  Proof.
    ii. exploit IN; eauto. i. des.
    econs; eauto. ii.
    exploit STEP; eauto. i. des. eauto.
  Qed.
  #[local]
  Hint Resolve _sim_mon: paco.

  Definition sim: SIM := paco2 _sim bot2.
End Simulation.
#[export]
Hint Resolve _sim_mon: paco.

Lemma sim_adequacy
      c_src c_tgt
      (WF_SRC: Configuration.wf c_src)
      (WF_TGT: Configuration.wf c_tgt)
      (SIM: sim c_src c_tgt):
  behaviors Configuration.step c_tgt <1= behaviors Configuration.step c_src.
Proof.
  i. revert c_src WF_SRC WF_TGT SIM.
  induction PR; i.
  - punfold SIM0. exploit SIM0; eauto. i. des.
    hexploit TERMINAL0; eauto. i. des.
    eapply rtc_tau_step_behavior; eauto.
    econs 1. eauto.
  - punfold SIM0. exploit SIM0; eauto. i. des.
    exploit STEP0; eauto. i. des.
    exploit Configuration.step_future; try exact STEP; eauto. i. des.
    exploit Configuration.opt_step_future; try exact STEP_SRC; eauto. i. des.
    inv SIM1; ss. inv STEP_SRC.
    econs 2; eauto.
  - punfold SIM0. exploit SIM0; eauto. i. des.
    exploit STEP0; eauto. i. des.
    exploit Configuration.step_future; try exact STEP; eauto. i. des.
    exploit Configuration.opt_step_future; try exact STEP_SRC; eauto. i. des.
    inv SIM1; ss. inv STEP_SRC.
    econs 3; eauto.
  - punfold SIM0. exploit SIM0; eauto. i. des.
    exploit STEP0; eauto. i. des.
    exploit Configuration.step_future; try exact STEP; eauto. i. des.
    exploit Configuration.opt_step_future; try exact STEP_SRC; eauto. i. des.
    inv SIM1; ss. inv STEP_SRC; eauto.
    econs 4; eauto.
Qed.


Require Import Bedrock.Platform.Cito.CompileStmtSpec.
Require Import Bedrock.StringSet.
Require Import Bedrock.Platform.Cito.FreeVars.
Require Import Bedrock.Platform.Cito.SynReqFactsUtil.

Local Infix ";;" := Syntax.Seq (right associativity, at level 95).

Lemma syn_req_Label_in : forall vars temp_size x lbl k, syn_req vars temp_size (Syntax.Label x lbl ;; k) -> List.In x vars.
  unfold syn_req, in_scope; simpl; intuition.
  apply Subset_union_left in H; intuition.
  apply Subset_singleton in H0.
  apply to_set_In; auto.
Qed.

Lemma syn_req_Assign_in : forall vars temp_size x e k, syn_req vars temp_size (Syntax.Assign x e ;; k) -> List.In x vars.
  unfold syn_req, in_scope; simpl; intuition.
  apply Subset_union_left in H; intuition.
  apply Subset_union_left in H0; intuition.
  apply Subset_singleton in H.
  apply to_set_In; auto.
Qed.


Require Export CalculusSM.
Require Export CalculusSM_tacs.

Section CalculusSM3.

  Context { pd  : @Data }.
  Context { pn  : @Node }.
  Context { pk  : @Key }.
  Context { pm  : @Msg }.
  Context { qc  : @Quorum_context pn}.
  Context { pat : @AuthTok }.
  Context { paf : @AuthFun pn pk pat pd }.
  Context { pda : @DataAuth pd pn }.
  Context { cad : @ContainedAuthData pd pat pm }.
  Context { dtc : @DTimeContext }.
  Context { iot : @IOTrustedFun }.
  Context { ctp : @ComponentTrust pd pn pat qc iot }.
  Context { cap : @ComponentAuth pd pn pk pat pm dtc iot }.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { base_fun_io       : baseFunIO           }.
  Context { base_state_fun    : baseStateFun        }.
  Context { trusted_state_fun : trustedStateFun     }.
  Context { pkc               : KnowledgeComponents }.
  Context { gms               : MsgStatus           }.

  Local Open Scope kn.

  (*  ****** PRIMITIVE RULES ****** *)

  (***********************************************************)
  Definition PRIMITIVE_RULE_beforele_if_eq x {eo : EventOrdering} e1 e2 Q R H a :=
    MkRule0
      [⟬Q ++ (x ⋈ e1 ▶ e2) :: R⟭ H ⊢ a]
      (⟬Q ++ (x ⋈ e1 ≡ e2) :: R⟭ H ⊢ a).

  Lemma PRIMITIVE_RULE_beforele_if_eq_true :
    forall x {eo : EventOrdering} e1 e2 Q R H a,
      rule_true (PRIMITIVE_RULE_beforele_if_eq x e1 e2 Q R H a).
  Proof.
    start_proving_primitive st ct ht.
    unfold seq_event in *; simpl in *.
    apply st0; simpl in *; tcsp.
    pose proof (ct (x ⋈ e1 ≡ e2)) as w.
    rewrite in_app_iff in w; simpl in w; autodimp w hyp; subst.
    introv i; apply in_app_iff in i; simpl in *; repndors; subst; simpl in *; tcsp; eauto 3 with eo;
      try (complete (apply ct; apply in_app_iff; simpl; tcsp)).
  Qed.

  (************************************************************************************************)
  Definition PRIMITIVE_RULE_forall_before_intro u {eo : EventOrdering} e R H t :=
    MkRule1
      (fun e' => [⟬(u ⋈ e' ▷ e) :: R⟭ H ⊢ t @ e'])
      (⟬R⟭ H ⊢ KE_FORALL_BEFORE t @ e).

  Lemma PRIMITIVE_RULE_forall_before_intro_true :
    forall u {eo : EventOrdering} e R H t,
      rule_true (PRIMITIVE_RULE_forall_before_intro u e R H t).
  Proof.
    start_proving_primitive st ct ht.
    introv lte; unfold seq_event in *; simpl in *.
    inst_hyp e' st'.
    apply st'; simpl; tcsp.
    introv h; repndors; subst; simpl in *; auto.
  Qed.

  (************************************************************************************************)
  Definition PRIMITIVE_RULE_similar_data_change_event {eo : EventOrdering} e1 e2 R H d1 d2 :=
    MkRule0
      [⟬ R ⟭ H ⊢ KE_SIMILAR_DATA d1 d2 @ e2]
      (⟬ R ⟭ H ⊢ KE_SIMILAR_DATA d1 d2 @ e1).

  Lemma PRIMITIVE_RULE_similar_data_change_event_true :
    forall {eo : EventOrdering} e1 e2 R H d1 d2,
      rule_true (PRIMITIVE_RULE_similar_data_change_event e1 e2 R H d1 d2).
  Proof.
    start_proving_primitive st ct ht.
    apply st0 in ht; simpl in *; tcsp.
  Qed.

  (************************************************************************************************)
  Definition PRIMITIVE_RULE_similar_data_sym {eo : EventOrdering} e R H d1 d2 :=
    MkRule0
      [⟬ R ⟭ H ⊢ KE_SIMILAR_DATA d1 d2 @ e]
      (⟬ R ⟭ H ⊢ KE_SIMILAR_DATA d2 d1 @ e).

  Lemma PRIMITIVE_RULE_similar_data_sym_true :
    forall {eo : EventOrdering} e R H d1 d2,
      rule_true (PRIMITIVE_RULE_similar_data_sym e R H d1 d2).
  Proof.
    start_proving_primitive st ct ht.
    apply st0 in ht; simpl in *; tcsp.
    apply kc_sim_data_sym; auto.
  Qed.

  (************************************************************************************************)
  Definition PRIMITIVE_RULE_data_eq_sym {eo : EventOrdering} e R H t1 t2 :=
    MkRule0
      [⟬ R ⟭ H ⊢ KE_DATA_EQ t2 t1 @ e]
      (⟬ R ⟭ H ⊢ KE_DATA_EQ t1 t2 @ e).

  Lemma PRIMITIVE_RULE_data_eq_sym_true :
    forall {eo : EventOrdering} e R H t1 t2,
      rule_true (PRIMITIVE_RULE_data_eq_sym e R H t1 t2).
  Proof.
    start_proving_primitive st ct ht.
    apply st0 in ht; simpl in *; tcsp.
  Qed.

End CalculusSM3.


From Equations Require Import Equations.
Require Import Ascii String.
Require Import FunctionalExtensionality.
From stdpp Require Import numbers.
Import N.

From Formalisation Require Export Span.
From FreeMonad Require Import FreeMonad.
From SepLogic Require Import SepSet.
From Formalisation Require Import IsFresh Inject ZeroCopy.
From Classes Require Import Foldable.
From Examples Require Import example2.

Require Import Coq.Program.Equality.

Open Scope N_scope.

Definition octet := N.

Definition data := list octet.

Inductive DECODE : Type -> Type :=
| TakeOp : N -> DECODE span
| ReadOp : span -> N -> DECODE octet
| FailOp : forall {X}, DECODE X.

Definition Decodeur := Free DECODE.

Definition take (n : N) : Decodeur span := gen (TakeOp n).

Definition read (s : span) (pos : N): Decodeur N := gen (ReadOp s pos).

Definition fail {X} : Decodeur X := gen FailOp.

Fixpoint wp {X} (m: Decodeur X) (Q : X -> iProp) : iProp :=
  match m with
  | ret v => Q v
  | op (TakeOp n) k => ∀ v, IsFresh v -∗ wp (k v) Q
  | op (ReadOp s n) k => ∀ v , wp (k v) Q
  | op FailOp _ => True
  end.

Local Open Scope free_monad_scope.

Lemma wp_bind {X Y} (e : Decodeur X) (f :  X → Decodeur Y) (Q : Y -> iProp) (Q' : X -> iProp) :
  wp e Q' ⊢
    (∀ v,  Q' v -∗ wp (f v) Q ) -∗
    wp (let! v := e in f v) Q %I.
Proof.
  iIntros "HA HB". revert e. fix e 1.
  destruct e0 as [v | Z []]; simpl; auto.
  - iApply ("HB" with "HA").
  - iIntros (v) "HC". iDestruct ("HA" with "HC") as "HA".
    iPoseProof "HB" as "HB". apply e.
  - iIntros (v). iDestruct ("HA" $! v) as "HA".
    iPoseProof "HB" as "HB". apply e.
Qed.

Lemma wp_consequence {X} (P Q : X -> iProp) (f : Decodeur X) :
  ⊢ wp f P -∗
    (∀ x, P x -∗ Q x) -∗
    wp f Q.
Proof.
  induction f as [v | Y [] k]; simpl; intros; auto.
  - iIntros "HA HB". iApply ("HB" with "HA").
  - iIntros "HA HB * HC". iDestruct ("HA" with "HC") as "HA".
    iApply (H with "HA HB").
  - iIntros "HA HB" (v). iApply (H with "HA HB").
Qed.

Notation "{{ P }} m {{ v ; Q }}" := (⊢ P -∗ wp m (fun v => Q))
                                      (at level 20,
                                        format "'[hv' {{  P  }}  '/  ' m  '/'  {{  v ;  Q  }} ']'").

Lemma rule_ret {X} (v : X) H (Q : X -> iProp) :
  (H ⊢ Q v) -> {{ H }} (ret v : Decodeur X) {{ v'; Q v' }}.
Proof. simpl; iIntros. iApply H0; auto. Qed.

Lemma rule_bind {X Y} (e : Decodeur X) (f : X -> Decodeur Y) Q Q' (H : iProp) :
  ({{ H }} e {{ v; Q' v }}) ->
  (∀ v, {{ Q' v }} f v {{ v'; Q v' }}) ->
  {{ H }} do v <- e; f v {{ v; Q v}}.
Proof.
  intros. iIntros "HA".
  iApply (wp_bind e f _ Q' with "[HA]").
  - iApply (H0 with "[HA]"); auto.
  - iIntros (v) "HC". iApply (H1 with "[HC]"); auto.
Qed.

Section Rules.

  Variable X: Type.
  Implicit Type P: iProp.
  Implicit Type Q: X -> iProp.

  Lemma rule_consequence: forall P P' Q Q' m,

      ({{ P' }} m {{ v; Q' v }}) ->
      (P ⊢ P') ->
      (forall v, Q' v ⊢ Q v) ->
      (*-----------------------*)
      {{ P }} m {{ v; Q v }}.
  Proof.
    intros. iIntros "HA". iDestruct (H0 with "HA") as "HA".
    iDestruct (H with "HA") as "HA". iApply (wp_consequence with "HA").
    iIntros "*". iApply H1.
  Qed.

  Lemma frame_bind : forall (P : iProp), ⊢ P -∗ emp ∗ P.
  Proof. iIntros "* $". Qed.

  Lemma rule_frame: forall P Q P' m,

      ({{ P }} m {{ v; Q v }}) ->
      (*----------------------------*)
      {{ P ∗ P' }} m {{ v; Q v ∗ P' }}.
  Proof.
    intros. iIntros "[HA HC]". iApply (wp_consequence with "[HA]").
    iApply H; auto. iIntros; iFrame.
  Qed.

  Lemma rule_fail H Q : {{ H }} fail {{ v; Q v }}.
  Proof. auto. Qed.

  Lemma rule_read s res : {{ emp }} read s res {{ _; emp }}.
  Proof. eauto. Qed.

  Lemma rule_take n : {{ emp }} take n {{ v; IsFresh v }}.
  Proof. simpl. eauto. Qed.

End Rules.

Record packet_SSHS (S : Type) :=
  mk_ssh {
      packet_length : N;
      padding_length : N;
      payload : S;
      mac : S; }.

Arguments mk_ssh [S].
Arguments packet_length [S].
Arguments padding_length [S].
Arguments payload [S].
Arguments mac [S].

Definition packet_SSH := packet_SSHS span.

Definition foldMap M (sg : Monoid.Semigroup M) (m : Monoid.Monoid M)
  {A} (fold : A -> M) (p : packet_SSHS A) : M :=
  Monoid.f (fold (payload p)) (fold (mac p)).

Local Instance Foldable_SSH : Foldable packet_SSHS :=
  Build_Foldable _ (@foldMap).

Definition decode_next : Decodeur N :=
  let! s := take 1 in
  read s 0.

Lemma rule_next : {{ emp }} decode_next {{ _; True }}.
Proof.
  eapply rule_bind.
  eapply rule_take.
  intro. eapply rule_consequence. eapply rule_frame. eapply rule_read.
  iIntros "HA". iSplitR; eauto. iApply "HA".
  eauto.
Qed.

Definition decode_u32 :=
  let! a := decode_next in
  let! b := decode_next in
  let! c := decode_next in
  let! d := decode_next in
  ret (to_u32 a b c d).

Lemma rule_u32 : {{ emp }} decode_u32 {{ _; True }}.
Proof.
  eapply rule_bind.
  eapply rule_next.
  intro. eapply rule_bind.
  eapply rule_consequence. eapply rule_frame. eapply rule_next.
  iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
  intro. eapply rule_bind.
  eapply rule_consequence. eapply rule_frame. eapply rule_next.
  iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
  intro. eapply rule_bind.
  eapply rule_consequence. eapply rule_frame. eapply rule_next.
  iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
  eauto.
Qed.

Definition decode_packet_SSH : Decodeur packet_SSH :=
  let! packet_length := decode_u32 in
  let! padding_length := decode_next in
  if padding_length + 1 <=? packet_length
  then
    let! payload := take (packet_length - padding_length - 1) in
    let! padding := take padding_length in
    let! mac := take 20 in
    ret (mk_ssh packet_length padding_length payload mac)
  else
    fail.

Lemma rule_decode_packet_SSH : {{ emp }} decode_packet_SSH {{ v; <absorb> all_disjointMSL v }}.
Proof.
  eapply rule_bind.
  eapply rule_u32.
  intro. eapply rule_bind.
  eapply rule_consequence. eapply rule_frame. eapply rule_next.
  iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
  intro. destruct (v0 + 1 <=? v).
  - eapply rule_bind.
    eapply rule_consequence. eapply rule_frame. eapply rule_take.
    iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
    intro. eapply rule_bind.
    eapply rule_consequence. eapply rule_frame. eapply rule_take.
    iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
    intros. eapply rule_bind.
    eapply rule_consequence. eapply rule_frame. eapply rule_take.
    iIntros "HA". iSplitR; eauto. iApply "HA". eauto.
    intros. eapply rule_ret. iIntros. iNorm.
    unfold all_disjointMSL, all_disjointSL. simpl. iFrame.
  - eapply rule_fail.
Qed.

Close Scope free_monad_scope.

Fixpoint eval {X} (m : Decodeur X) : DecodeurM X :=
  match m with
  | ret v => ret! v
  | op (TakeOp n) k =>
      let! v := takeM n in
      eval (k v)
  | op (ReadOp s pos) k =>
      let! v := readM s pos in
      eval (k v)
  | op FailOp _ => failM
  end.

Definition decode {X} (d : Decodeur X) (data : data) : option X :=
  match eval d data (mk_span 0 (length data)) with
  | Some (v, _) => Some v
  | _ => None
  end.

Lemma eval_monotone : forall X (e : Decodeur X) s1 s2 a v,
    eval e a s1 = Some (v, s2) ->
    (pos s1 <= pos s2)%N /\ (pos s2 + len s2 <= pos s1 + len s1)%N.
Proof.
  fix IH 2.
  destruct e as [v  | Y []]; simpl; intros.
  - inversion H. split; lia.
  - unfold eval in H. fold (@eval X) in H. unfold bind in H. unfold takeM in H.
    destruct ((n <=? len s1)%N) eqn:?. 2 : inversion H.
    eapply IH in H as [P0 P1]. eapply N.leb_le in Heqb. simpl in *. lia.
  - unfold eval in H. fold (@eval X) in H. unfold bind in H. unfold readM in H.
    destruct ((n <? len s)%N) eqn:?. 2 : inversion H.
    destruct (lookup (pos s + n) a). 2 : inversion H.
    eapply IH in H as [P0 P1]. eapply N.ltb_lt in Heqb. lia.
  - inversion H.
Qed.

Lemma soundness : forall X d H (Q : X -> iProp),
    {{ H }} d {{v ; Q v }} ->
    forall data s (v : X) s',
      eval d data s = Some (v, s') ->
      H ∗ injectSL (pos s) (pos s') ⊢ Q v.
Proof.
  fix IH 2.
  destruct d as [v | Y []]; simpl; intros.
  (* ret *)
  - iIntros "[HA HB]". inversion H1. subst.
    iDestruct (injectSL_emp with "HB") as "_". lia.
    iApply (H0 with "HA").
  (* take *)
  - unfold eval in H1. fold (@eval X) in H1. unfold bind in H1. unfold takeM in H1.
    destruct ((n <=? len s)%N) eqn:?.
    2 : inversion H1.
    epose H1 as grow.
    eapply eval_monotone in grow as [P0 P1]. simpl in *.
    iIntros "[HA HB]". iApply IH; eauto. simpl.
    unfold injectSL. rewrite (inject_union (pos s + n)). 2-3 : lia.
    iDestruct (big_sepS_union with "HB") as "[HC HB]". apply inject_disjoint.
    iSplitR "HB"; eauto.
    iApply (H0 with "HA [HC]").
    iApply (inject_IsFresh with "HC"); simpl; lia.
  (* read *)
  - unfold eval in H1. fold (@eval X) in H1. unfold bind in H1. unfold readM in H1.
    destruct ((n <? len s)%N) eqn:?. 2 : inversion H1.
    destruct (lookup (pos s + n) data0). 2 : inversion H1.
    iIntros "[HA HB]". iApply IH; eauto. iFrame. iApply (H0 with "HA").
  (* fail *)
  - inversion H1.
Qed.

Theorem adequacy : forall X d (Q : X -> Prop),
    {{ emp }} d {{ v; ⌜Q v⌝ }} ->
    forall data v,
      decode d data = Some v ->
      Q v.
Proof.
  intros. unfold decode in H0.
  destruct (eval d data0) as  [[r s]| ] eqn:?. 2 : inversion H0.
  injection H0. intro. subst. eapply soundness_pure.
  iIntros "HA". iApply (soundness _ d emp (fun v => ⌜ Q v ⌝)); eauto.
  iSplitR; auto. simpl. iApply big_op_ctx. eauto.
Qed.

Lemma Fresh_ZC_aux `{Foldable M}: forall e s n s_res,
    {{ injectSL n (pos s) }} e {{ res; <absorb> all_disjointMSL res }} ->
    forall (data : data) (res : M span),
      n <= pos s ->
      eval e data s = Some (res, s_res) ->
      forall v, v ∈ M_to_list res ->
           set_span v ⊆ inject n (pos s + len s).
Proof.
  revert M H. fix IH 3. intros M H e.
  dependent destruction e; intros; simpl in *. revert H1 H2. intros LE H1.
  - inversion H1. subst. clear H1.
    revert H0. MonPred.unseal. unfold monpred.monPred_wand_def. simpl.
    unfold monpred.monPred_upclosed. simpl. intro. destruct H0. simpl in *.
    edestruct (monPred_in_entails tt). clear monPred_in_entails.
    instantiate (1 := ∅). MonPred.unseal.
    split. split. inversion_star h P. clear H0.
    red in P1. destruct P1. inversion H1. subst. clear H1. clear P2.
    rewrite union_empty_r_L in P. clear monPred_in_entails. subst.
    edestruct H0.
    + eexists ∅, _. repeat split; auto. 2 : eapply disjoint_empty_l.
      eapply SepSet.soundness. iIntros "HA". iApply big_op_ctx. iApply "HA".
    + destruct H1 as [h [P3 [P1 [P2 P4]]]]. clear H0 P0 P3.
      rewrite union_empty_l_L in P4.
      transitivity (inject n (Span.pos s_res)).
      2 : { eapply inject_mono_r. lia. }
      rewrite P4. transitivity h. 2 : set_solver. clear P2 P4. unfold all_disjointMSL in P1.
      eapply (all_disjointSL_incl _ _ H3 _ P1).
  - destruct d; simpl in *.
    + unfold set_span.
      unfold bind, takeM in H2.
      destruct (n0 <=? len s) eqn:?.
      * pose (mono := H2). eapply eval_monotone in mono as [P0 P1]. simpl in *.
        eapply N.leb_le in Heqb. assert (pos s + len s = pos s + n0 + (len s - n0)) by lia.
        rewrite H4.
        unfold set_span in IH.
        eapply (IH _ _ _ {| pos := pos s + n0; len := len s - n0 |}); simpl in *; eauto.
        2 : lia.
        iIntros "HA". unfold injectSL. rewrite (inject_add n0 n (pos s)). 2 : lia.
        iDestruct (big_sepS_union with "HA") as "[HA HB]". eapply inject_disjoint.
        iDestruct (inject_IsFresh with "[HB]") as "HB"; eauto.
        unfold injectSL. instantiate (1 := (mk_span (pos s) n0)). simpl. iApply "HB".
        iApply (H0 with "HA HB").
      * inversion H2.
    + unfold bind, readM in H2.
      destruct (n0 <? len s0) eqn:?.
      destruct (lookup (pos s0 + n0) data0) eqn:?.
      eapply IH; eauto.
      iIntros "HA". iDestruct (H0 with "HA") as "HB". iApply "HB".
      inversion H2. inversion H2.
    + inversion H2.
Qed.

Lemma eval_ZC `{Foldable M}: forall e,
    {{ emp }} e {{ res; <absorb> all_disjointMSL res }} ->
    forall (data : data) (res : M span) s s_res,
      eval e data s = Some (res, s_res) ->
      Result_in res s.
Proof.
  unfold Result_in. intros. eapply Fresh_ZC_aux.
   iIntros "HA". iApply H0.
   iApply (injectSL_emp with "HA"). lia. lia. eauto. auto.
Qed.

Definition decode_zerocopy `{Foldable M} (e : Decodeur (M span)) := forall data res,
      decode e data = Some res ->
      Result_in res (mk_span 0 (length data)).

Lemma decode_ZC `{Foldable M}: forall e,
    {{ emp }} e {{ res; <absorb> all_disjointMSL res }} ->
    decode_zerocopy e.
Proof.
  unfold decode_zerocopy, decode. intros.
  destruct eval as [[v s_v]|] eqn:?; inversion H1. subst.
  eapply eval_ZC; eauto.
Qed.