Require Import Kami.Notations.
Require Import Kami.Syntax.
Require Import List.
Require Import Kami.Rewrites.Notations_rewrites.
Require Import Program.Equality.
Require Import Kami.Rewrites.ReflectionPre.
Require Import Kami.Rewrites.ReflectionSoundTopTheorems.
Require Import Kami.Rewrites.ReflectionSoundTheorems1.
Require Import Kami.Rewrites.ReflectionSoundTheorems2.
Require Import Kami.WfMod_Helper.

Definition KRSimplifyTop_ImplProp (e: KRExpr_Prop) : KRExpr_Prop :=
  match e with
  | KRDisjKey_RegInitT a b => match a with
                              | KRApp_list_RegInitT x y => KRAnd_Prop (KRDisjKey_RegInitT x b) (KRDisjKey_RegInitT y b)
                              | KRCons_list_RegInitT x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_RegInitT_string x) (KRmap_RegInitT_string KRfst_RegInitT_string_Func b))) (KRDisjKey_RegInitT y b)
                              | KRNil_list_RegInitT => KRTrue_Prop
                              | _ => match b with
                                     | KRApp_list_RegInitT x y => KRAnd_Prop (KRDisjKey_RegInitT a x) (KRDisjKey_RegInitT a y)
                                     | KRCons_list_RegInitT x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_RegInitT_string x) (KRmap_RegInitT_string KRfst_RegInitT_string_Func a))) (KRDisjKey_RegInitT a y)
                                     | KRNil_list_RegInitT => KRTrue_Prop
                                     | _ => KRDisjKey_RegInitT a b
                                     end
                              end
  | KRDisjKey_DefMethT a b => match a with
                              | KRApp_list_DefMethT x y => KRAnd_Prop (KRDisjKey_DefMethT x b) (KRDisjKey_DefMethT y b)
                              | KRCons_list_DefMethT x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_DefMethT_string x) (KRmap_DefMethT_string KRfst_DefMethT_string_Func b))) (KRDisjKey_DefMethT y b)
                              | KRNil_list_DefMethT => KRTrue_Prop
                              | _ => match b with
                                     | KRApp_list_DefMethT x y => KRAnd_Prop (KRDisjKey_DefMethT a x) (KRDisjKey_DefMethT a y)
                                     | KRCons_list_DefMethT x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_DefMethT_string x) (KRmap_DefMethT_string KRfst_DefMethT_string_Func a))) (KRDisjKey_DefMethT a y)
                                     | KRNil_list_DefMethT => KRTrue_Prop
                                     | _ => KRDisjKey_DefMethT a b
                                     end
                              end
  | KRDisjKey_Rule a b => match a with
                          | KRApp_list_Rule x y => KRAnd_Prop (KRDisjKey_Rule x b) (KRDisjKey_Rule y b)
                          | KRCons_list_Rule x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_Rule_string x) (KRmap_Rule_string KRfst_Rule_string_Func b))) (KRDisjKey_Rule y b)
                          | KRNil_list_Rule => KRTrue_Prop
                          | _ => match b with
                                 | KRApp_list_Rule x y => KRAnd_Prop (KRDisjKey_Rule a x) (KRDisjKey_Rule a y)
                                 | KRCons_list_Rule x y => KRAnd_Prop (KRNot_Prop (KRIn_string_Prop (KRfst_Rule_string x) (KRmap_Rule_string KRfst_Rule_string_Func a))) (KRDisjKey_Rule a y)
                                 | KRNil_list_Rule => KRTrue_Prop
                                 | _ => KRDisjKey_Rule a b
                                 end
                          end
  | KRAnd_Prop a KRTrue_Prop => a
  | KRAnd_Prop a KRFalse_Prop => KRFalse_Prop
  | KRAnd_Prop KRTrue_Prop a => a
  | KRAnd_Prop KRFalse_Prop a => KRFalse_Prop
  | KROr_Prop a KRTrue_Prop => KRTrue_Prop
  | KROr_Prop a KRFalse_Prop => a
  | KROr_Prop KRTrue_Prop a => KRTrue_Prop
  | KROr_Prop KRFalse_Prop a => a
  | KRNot_Prop (KRTrue_Prop) => KRFalse_Prop
  | KRNot_Prop (KRFalse_Prop) => KRTrue_Prop
  (*| KRNot_Prop (KRNot_Prop a) => a*)
  (*| KRNot_Prop (KRAnd_Prop a b) => (KROr_Prop (KRNot_Prop a) (KRNot_Prop b))
  | KRNot_Prop (KROr_Prop a b) => (KRAnd_Prop (KRNot_Prop a) (KRNot_Prop b))*)
  | KRIn_string_Prop x (KRApp_list_string a b) => (KROr_Prop (KRIn_string_Prop x a) (KRIn_string_Prop x b))
  | KRIn_string_Prop x (KRCons_list_string a b) => (KROr_Prop (KREq_string_Prop x a) (KRIn_string_Prop x b))
  | KRIn_string_Prop x (KRNil_list_string) => KRFalse_Prop
  | KRIn_RegInitT_Prop x (KRApp_list_RegInitT a b) => (KROr_Prop (KRIn_RegInitT_Prop x a) (KRIn_RegInitT_Prop x b))
  | KRIn_RegInitT_Prop x (KRCons_list_RegInitT a b) => (KROr_Prop (KREq_RegInitT_Prop x a) (KRIn_RegInitT_Prop x b))
  | KRIn_RegInitT_Prop x (KRNil_list_RegInitT) => KRFalse_Prop
  | KRIn_Rule_Prop x (KRApp_list_Rule a b) => (KROr_Prop (KRIn_Rule_Prop x a) (KRIn_Rule_Prop x b))
  | KRIn_Rule_Prop x (KRCons_list_Rule a b) => (KROr_Prop (KREq_Rule_Prop x a) (KRIn_Rule_Prop x b))
  | KRIn_Rule_Prop x (KRNil_list_Rule) => KRFalse_Prop
  | KRIn_DefMethT_Prop x (KRApp_list_DefMethT a b) => (KROr_Prop (KRIn_DefMethT_Prop x a) (KRIn_DefMethT_Prop x b))
  | KRIn_DefMethT_Prop x (KRCons_list_DefMethT a b) => (KROr_Prop (KREq_DefMethT_Prop x a) (KRIn_DefMethT_Prop x b))
  | KRIn_DefMethT_Prop x (KRNil_list_DefMethT) => KRFalse_Prop
  | KREq_string_Prop (KRstring_append p (KRConst_string a)) (KRstring_append q (KRConst_string b)) => if sdisjPrefix (srev a) (srev b) then KRFalse_Prop else e
  (*| KREq_string_Prop (KRstring_append (KRVar_string p) a) (KRstring_append (KRVar_string q) b) => if String.eqb p q then (KREq_string_Prop a b) else KREq_string_Prop (KRstring_append (KRVar_string p) a) (KRstring_append (KRVar_string q) b)
  | KREq_string_Prop (KRVar_string a) (KRVar_string b) => if String.eqb a b then KRTrue_Prop else
                                                            (KREq_string_Prop (KRVar_string a) (KRVar_string b))*)
  | e => e
  end.

Fixpoint KRSimplify_ImplProp(p:KRExpr_Prop) :=
       KRSimplifyTop_ImplProp (match p with
                           | KRAnd_Prop a b => KRAnd_Prop (KRSimplify_ImplProp a) (KRSimplify_ImplProp b)
                           | KROr_Prop a b => KROr_Prop (KRSimplify_ImplProp a) (KRSimplify_ImplProp b)
                           | KRNot_Prop a => KRNot_Prop (KRSimplify_ImplProp a)
                           | KRIn_string_Prop a b => KRIn_string_Prop (KRSimplify_string a) (KRSimplify_list_string b)
                           | KRIn_RegInitT_Prop a b => KRIn_RegInitT_Prop (KRSimplify_RegInitT a) (KRSimplify_list_RegInitT b)
                           | KRIn_DefMethT_Prop a b => KRIn_DefMethT_Prop (KRSimplify_DefMethT a) (KRSimplify_list_DefMethT b)
                           | KRIn_Rule_Prop a b => KRIn_Rule_Prop (KRSimplify_Rule a) (KRSimplify_list_Rule b)
                           | KRDisjKey_RegInitT a b => KRDisjKey_RegInitT (KRSimplify_list_RegInitT a) (KRSimplify_list_RegInitT b)
                           | KRDisjKey_DefMethT a b => KRDisjKey_DefMethT (KRSimplify_list_DefMethT a) (KRSimplify_list_DefMethT b)
                           | KRDisjKey_Rule a b => KRDisjKey_Rule (KRSimplify_list_Rule a) (KRSimplify_list_Rule b)
                           | KREq_string_Prop a b => KREq_string_Prop (KRSimplify_string a) (KRSimplify_string b)
                           | KREq_RegInitT_Prop a b => KREq_RegInitT_Prop (KRSimplify_RegInitT a) (KRSimplify_RegInitT b)
                           | KREq_Rule_Prop a b => KREq_Rule_Prop (KRSimplify_Rule a) (KRSimplify_Rule b)
                           | KREq_DefMethT_Prop a b => KREq_DefMethT_Prop (KRSimplify_DefMethT a) (KRSimplify_DefMethT b)
                           | p => p
                           end).

Theorem KRSimplify_ImplProp_KRAnd_Prop: forall a b,
     KRSimplify_ImplProp (KRAnd_Prop a b)= KRSimplifyTop_ImplProp (KRAnd_Prop (KRSimplify_ImplProp a) (KRSimplify_ImplProp b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRAnd_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KROr_Prop: forall a b,
     KRSimplify_ImplProp (KROr_Prop a b)= KRSimplifyTop_ImplProp (KROr_Prop (KRSimplify_ImplProp a) (KRSimplify_ImplProp b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KROr_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRNot_Prop: forall a,
     KRSimplify_ImplProp (KRNot_Prop a)= KRSimplifyTop_ImplProp (KRNot_Prop (KRSimplify_ImplProp a)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRNot_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRIn_string_Prop: forall a b,
     KRSimplify_ImplProp (KRIn_string_Prop a b)= KRSimplifyTop_ImplProp (KRIn_string_Prop (KRSimplify_string a) (KRSimplify_list_string b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRIn_string_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRIn_RegInitT_Prop: forall a b,
     KRSimplify_ImplProp (KRIn_RegInitT_Prop a b)= KRSimplifyTop_ImplProp (KRIn_RegInitT_Prop (KRSimplify_RegInitT a) (KRSimplify_list_RegInitT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRIn_RegInitT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRIn_DefMethT_Prop: forall a b,
     KRSimplify_ImplProp (KRIn_DefMethT_Prop a b)= KRSimplifyTop_ImplProp (KRIn_DefMethT_Prop (KRSimplify_DefMethT a) (KRSimplify_list_DefMethT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRIn_DefMethT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRIn_Rule_Prop: forall a b,
     KRSimplify_ImplProp (KRIn_Rule_Prop a b)= KRSimplifyTop_ImplProp (KRIn_Rule_Prop (KRSimplify_Rule a) (KRSimplify_list_Rule b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRIn_Rule_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRDisjKey_RegInitT_Prop: forall a b,
     KRSimplify_ImplProp (KRDisjKey_RegInitT a b)= KRSimplifyTop_ImplProp (KRDisjKey_RegInitT (KRSimplify_list_RegInitT a) (KRSimplify_list_RegInitT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRDisjKey_RegInitT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRDisjKey_DefMethT_Prop: forall a b,
     KRSimplify_ImplProp (KRDisjKey_DefMethT a b)= KRSimplifyTop_ImplProp (KRDisjKey_DefMethT (KRSimplify_list_DefMethT a) (KRSimplify_list_DefMethT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRDisjKey_DefMethT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KRDisjKey_Rule_Prop: forall a b,
     KRSimplify_ImplProp (KRDisjKey_Rule a b)= KRSimplifyTop_ImplProp (KRDisjKey_Rule (KRSimplify_list_Rule a) (KRSimplify_list_Rule b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KRDisjKey_Rule_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KREq_string_Prop: forall a b,
     KRSimplify_ImplProp (KREq_string_Prop a b)= KRSimplifyTop_ImplProp (KREq_string_Prop (KRSimplify_string a) (KRSimplify_string b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KREq_string_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KREq_RegInitT_Prop: forall a b,
     KRSimplify_ImplProp (KREq_RegInitT_Prop a b)= KRSimplifyTop_ImplProp (KREq_RegInitT_Prop (KRSimplify_RegInitT a) (KRSimplify_RegInitT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KREq_RegInitT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KREq_DefMethT_Prop: forall a b,
     KRSimplify_ImplProp (KREq_DefMethT_Prop a b)= KRSimplifyTop_ImplProp (KREq_DefMethT_Prop (KRSimplify_DefMethT a) (KRSimplify_DefMethT b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KREq_DefMethT_Prop : KRSimplify.

Theorem KRSimplify_ImplProp_KREq_Rule_Prop: forall a b,
     KRSimplify_ImplProp (KREq_Rule_Prop a b)= KRSimplifyTop_ImplProp (KREq_Rule_Prop (KRSimplify_Rule a) (KRSimplify_Rule b)).
Proof.
  reflexivity.
Qed.

Hint Rewrite KRSimplify_ImplProp_KREq_Rule_Prop : KRSimplify.

Theorem sdisjPrefix_false': forall p1 p2 s1 s2,
    sdisjPrefix (srev s1) (srev s2)=true -> (p1++s1=p2++s2)%string -> False.
Proof.
  intros p1 p2 s1 s2.
  repeat (rewrite <- sappend_append).
  assert ((p2++s2)%string=sappend p2 s2).
  - rewrite <- sappend_append.
    reflexivity.
  - rewrite H.
    intros.
    eapply sdisjPrefix_sappend_false.
    + apply H0.
    + apply H1.
Qed.

Ltac unitSolve :=
  simpl in *; simpl;
  match goal with
  | H: ?X |- ?X => apply H
  | |- True => apply I
  | H: False |- _ => inversion H
  | H: _ /\ _ |- _ => inversion H; subst; clear H; unitSolve
  | H: _ \/ _ |- _ => inversion H; subst; clear H; unitSolve
  | |- _ \/ _ => left; solve [unitSolve]
  | |- _ \/ _ => right; solve [unitSolve]
  | |- _ /\ _ => split; unitSolve
  | |- DisjKey _ [] => apply DisjKey_nil2
  | |- DisjKey [] _ => apply DisjKey_nil1
  | |- DisjKey (_::_) _ => apply DisjKey_Cons1; unitSolve
  | |- DisjKey _ (_::_) => apply DisjKey_Cons2; unitSolve
  | |- DisjKey (_++_) _ => apply DisjKey_Append1; unitSolve
  | |- DisjKey _ (_++_) => apply DisjKey_Append2; unitSolve
  (*| H: DisjKey _ [] |- _ => inversion H; subst; clear H; unitSolve
  | H: DisjKey [] _ |- _ => inversion H; subst; clear H; unitSolve
  | H: DisjKey (_::_) _ |- _ => rewrite DisjKey_Cons1 in H; unitSolve
  | H: DisjKey _ (_::_) |- _ => rewrite DisjKey_Cons2 in H; unitSolve
  | H: DisjKey (_++_) _ |- _ => inversion H; subst; clear H; unitSolve
  | H: DisjKey _ (_++_) |- _ => inversion H; subst; clear H; unitSolve*)
  | |- { _=_ }+{ _<>_ } => repeat (decide equality)
  | |- forall _,_ => intros; unitSolve
  end.

Theorem KRSimplifyTopSound_ImplProp: forall e,
    KRExprDenote_Prop (KRSimplifyTop_ImplProp e) -> KRExprDenote_Prop e.
Proof.
  intros.
  destruct e; try unitSolve.
  - destruct e1; destruct e2; split; try (unitSolve).
  - destruct e1; destruct e2; try (unitSolve).
  - destruct e; try (unitSolve).
    + simpl.
      intro X.
      apply X.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app.
      try unitSolve.
  - destruct k; destruct k0; try unitSolve; try (destruct k2; unitSolve).
    destruct k2; try unitSolve.
    destruct k0_2; try unitSolve.
    simpl in H.
    simpl.
    remember (sdisjPrefix (srev s) (srev s0)).
    destruct b.
    * simpl in H.
      inversion H.
    * simpl in H.
      apply H.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app.
      try unitSolve.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app.
      try unitSolve.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app.
      try unitSolve.
  - destruct k; destruct k0; try unitSolve.
  - destruct k; destruct k0; try unitSolve.
  - destruct k; destruct k0; try unitSolve.
Qed.

Theorem KRSimplifyTopSound_RevImplProp: forall e,
    KRExprDenote_Prop e -> KRExprDenote_Prop (KRSimplifyTop_ImplProp e).
Proof.
  intros.
  destruct e; try unitSolve.
  - destruct e1; destruct e2; try (unitSolve).
  - destruct e1; destruct e2; try (unitSolve).
  - destruct e; try (unitSolve).
    + simpl in H.
      simpl.
      apply H.
      apply I.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app in H.
      try unitSolve.
  - destruct k; destruct k0; try unitSolve; try (destruct k2; unitSolve).
    destruct k2; try unitSolve.
    destruct k0_2; try unitSolve.
    simpl in H.
    simpl.
    remember (sdisjPrefix (srev s) (srev s0)).
    destruct b.
    * apply sdisjPrefix_false' in H. simpl in H.
      ++ inversion H.
      ++ rewrite Heqb.
         reflexivity.
    * simpl.
      apply H.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app in H.
      try unitSolve.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app in H.
      try unitSolve.
  - destruct k0; try unitSolve.
    + simpl in H.
      simpl.
      inversion H; subst; clear H.
      * left.
        rewrite H0.
        reflexivity.
      * right.
        apply H0.
    + simpl in H.
      simpl.
      rewrite in_app in H.
      try unitSolve.
  - destruct k; destruct k0; try unitSolve.
    + simpl in H; rewrite DisjKey_Cons2 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H; rewrite DisjKey_Append2 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H; rewrite DisjKey_Cons1 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H. simpl. split.
      * intro X.
        inversion X.
      * apply DisjKey_Cons1 in H.
        inversion H; subst; clear H.
        apply H1.
        repeat (decide equality).
    + simpl.
      rewrite DisjKey_Cons2.
      simpl in H.
      rewrite DisjKey_Cons2 in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      simpl in H0.
      inversion H1; subst; clear H1.
      split.
      * intro X.
        inversion X; subst; clear X.
        ++ rewrite H1 in H0.
           simpl in H0.
           apply H0.
           left.
           reflexivity.
        ++ apply H.
           apply H1.
      * split.
        ++ intro X.
           apply H0.
           right.
           apply X.
        ++ apply H2.
      * repeat (decide equality).
      * intros.
        repeat (decide equality).
      * intros.
        repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      split.
      * apply H0.
      * apply H1.
      * intros.
        repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
  - destruct k; destruct k0; try unitSolve.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      split.
      * intro X.
        inversion X.
      * apply DisjKey_nil2.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      simpl in H.
      inversion H; subst; clear H.
      rewrite DisjKey_Cons1 in H1;try (repeat (decide equality)).
      inversion H1; subst; clear H1.
      split.
      * intro X.
        inversion X; subst; clear X.
        ++ rewrite H1 in H0.
           simpl in H0.
           apply H0.
           left.
           reflexivity.
        ++ apply H.
           apply H1.
      * rewrite DisjKey_Cons2; try (repeat (decide equality)).
        split.
        ++ intro X.
           apply H0.
           right.
           apply X.
        ++ apply H2.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
  - destruct k; destruct k0; try unitSolve.
    + simpl in H; rewrite DisjKey_Cons2 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H; rewrite DisjKey_Append2 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H; rewrite DisjKey_Cons1 in H; [simpl; apply H | repeat (decide equality)].
    + simpl in H. simpl. split.
      * intro X.
        inversion X.
      * apply DisjKey_Cons1 in H.
        inversion H; subst; clear H.
        apply H1.
        repeat (decide equality).
    + simpl.
      rewrite DisjKey_Cons2.
      simpl in H.
      rewrite DisjKey_Cons2 in H.
      rewrite DisjKey_Cons1 in H.
      inversion H; subst; clear H.
      simpl in H0.
      inversion H1; subst; clear H1.
      split.
      * intro X.
        inversion X; subst; clear X.
        ++ rewrite H1 in H0.
           simpl in H0.
           apply H0.
           left.
           reflexivity.
        ++ apply H.
           apply H1.
      * split.
        ++ intro X.
           apply H0.
           right.
           apply X.
        ++ apply H2.
      * repeat (decide equality).
      * intros.
        repeat (decide equality).
      * intros.
        repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Append1 in H.
      unitSolve.
      repeat (decide equality).
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Cons2 in H;try (repeat (decide equality)).
      apply H.
    + simpl.
      simpl in H.
      rewrite DisjKey_Append2 in H;try (repeat (decide equality)).
      apply H.
Qed.

Theorem KRSimplifySound_ImplProp: forall e,
    KRExprDenote_Prop (KRSimplify_ImplProp e) <-> KRExprDenote_Prop e.
Proof.
  induction e; try (simpl; split; unitSolve).
  - split.
    * intros.
      simpl.
      autorewrite with KRSimplify in H.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      inversion H; subst; clear H.
      apply IHe1 in H0.
      apply IHe2 in H1.
      split.
      ++ apply H0.
      ++ apply H1.
    * intros.
      simpl in H.
      autorewrite with KRSimplify.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      inversion H; subst; clear H.
      split.
      ++ apply IHe1.
         apply H0.
      ++ apply IHe2.
         apply H1.
  - split.
    * intros.
      simpl.
      autorewrite with KRSimplify in H.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      inversion H; subst; clear H.
      + left.
        apply IHe1.
        apply H0.
      + right.
        apply IHe2.
        apply H0.
    * intros.
      simpl in H.
      autorewrite with KRSimplify.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      inversion H; subst; clear H.
      + left.
        apply IHe1.
        apply H0.
      + right.
        apply IHe2.
        apply H0.
  - split.
    * intros.
      simpl.
      autorewrite with KRSimplify in H.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      intro X.
      apply IHe in X.
      apply H in X.
      inversion X.
    * intros.
      simpl in H.
      autorewrite with KRSimplify.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      intro X.
      apply IHe in X.
      apply H in X.
      inversion X.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
  - autorewrite with KRSimplify.
    split.
    * intros.
      simpl.
      apply KRSimplifyTopSound_ImplProp in H.
      simpl in H.
      autorewrite with KRSimplify in H.
      apply H.
    * intros.
      simpl in H.
      apply KRSimplifyTopSound_RevImplProp.
      simpl.
      autorewrite with KRSimplify.
      apply H.
Qed.

Hint Rewrite KRSimplifySound_ImplProp : KRSimplify.

(*Goal forall (a:ModuleElt) (b:list ModuleElt) c, app (cons a b) c=cons a (app b c).
  intros.
  match goal with
  | |- ?A = ?B => let x := (ltac:(KRExprReify A (KRTypeList (KRTypeElem KRElemModuleElt)))) in
                  change A with (KRExprDenote_list_ModuleElt x);
                    rewrite KRSimplifySound_list_ModuleElt;
                    cbv [KRSimplify_list_ModuleElt KRSimplifyTop_list_ModuleElt KRExprDenote_list_ModuleElt KRExprDenote_ModuleElt KRSimplifyTop_ModuleElt KRSimplify_ModuleElt]
  end.
Abort.*)

Ltac KRSimplifyTac e tp :=
  let x := (ltac:(KRExprReify e tp)) in
  let denote := match tp with
                | (KRTypeElem KRElemRegInitT) => KRExprDenote_RegInitT
                | (KRTypeElem KRElemRule) => KRExprDenote_Rule
                | (KRTypeElem KRElemDefMethT) => KRExprDenote_DefMethT
                | (KRTypeElem KRElemModuleElt) => KRExprDenote_ModuleElt
                | (KRTypeList (KRTypeElem KRElemRegInitT)) => KRExprDenote_list_RegInitT
                | (KRTypeList (KRTypeElem KRElemRule)) => KRExprDenote_list_Rule
                | (KRTypeList (KRTypeElem KRElemDefMethT)) => KRExprDenote_list_DefMethT
                | (KRTypeList (KRTypeElem KRElemModuleElt)) => KRExprDenote_list_ModuleElt
                | (KRTypeList (KRTypeList (KRTypeElem KRElemRegInitT))) => KRExprDenote_list_list_RegInitT
                | (KRTypeList (KRTypeList (KRTypeElem KRElemRule))) => KRExprDenote_list_list_Rule
                | (KRTypeList (KRTypeList (KRTypeElem KRElemDefMethT))) => KRExprDenote_list_list_DefMethT
                | (KRTypeList (KRTypeList (KRTypeElem KRElemModuleElt))) => KRExprDenote_list_list_ModuleElt
                | (KRTypeElem KRElemBaseModule) => KRExprDenote_BaseModule
                | (KRTypeElem KRElemMod) => KRExprDenote_Mod
                | (KRTypeList (KRTypeElem KRElemMod)) => KRExprDenote_list_Mod
                | (KRTypeElem KRElemString) => KRExprDenote_string
                | (KRTypeList (KRTypeElem KRElemString)) => KRExprDenote_list_string
                | (KRTypeList (KRTypeList (KRTypeElem KRElemString))) => KRExprDenote_list_list_string
                | (KRTypeElem KRElemRegFileBase) => KRExprDenote_RegFileBase
                | (KRTypeList (KRTypeElem KRElemRegFileBase)) => KRExprDenote_list_RegFileBase
                | (KRTypeElem KRElemCallWithSign) => KRExprDenote_CallWithSign
                | (KRTypeList (KRTypeElem KRElemCallWithSign)) => KRExprDenote_list_CallWithSign
                | (KRTypeList (KRTypeList (KRTypeElem KRElemCallWithSign))) => KRExprDenote_list_list_CallWithSign
                | (KRTypeElem KRElemProp) => KRExprDenote_Prop
                end in
  let simplifySound := match tp with
                | (KRTypeElem KRElemRegInitT) => KRSimplifySound_RegInitT
                | (KRTypeElem KRElemRule) => KRSimplifySound_Rule
                | (KRTypeElem KRElemDefMethT) => KRSimplifySound_DefMethT
                | (KRTypeElem KRElemModuleElt) => KRSimplifySound_ModuleElt
                | (KRTypeList (KRTypeElem KRElemRegInitT)) => KRSimplifySound_list_RegInitT
                | (KRTypeList (KRTypeElem KRElemRule)) => KRSimplifySound_list_Rule
                | (KRTypeList (KRTypeElem KRElemDefMethT)) => KRSimplifySound_list_DefMethT
                | (KRTypeList (KRTypeElem KRElemModuleElt)) => KRSimplifySound_list_ModuleElt
                | (KRTypeList (KRTypeList (KRTypeElem KRElemRegInitT))) => KRSimplifySound_list_RegInitT
                | (KRTypeList (KRTypeList (KRTypeElem KRElemRule))) => KRSimplifySound_list_Rule
                | (KRTypeList (KRTypeList (KRTypeElem KRElemDefMethT))) => KRSimplifySound_list_DefMethT
                | (KRTypeList (KRTypeList (KRTypeElem KRElemModuleElt))) => KRSimplifySound_list_list_ModuleElt
                | (KRTypeElem KRElemString) => KRSimplifySound_string
                | (KRTypeList (KRTypeElem KRElemString)) => KRSimplifySound_list_string
                | (KRTypeList (KRTypeList (KRTypeElem KRElemString))) => KRSimplifySound_list_list_string
                | (KRTypeElem KRElemRegFileBase) => KRSimplifySound_RegFileBase
                | (KRTypeList (KRTypeElem KRElemRegFileBase)) => KRSimplify_list_RegFileBase
                | (KRTypeElem KRElemCallWithSign) => KRSimplifySound_CallWithSign
                | (KRTypeList (KRTypeElem KRElemCallWithSign)) => KRSimplify_list_CallWithSign
                | (KRTypeElem KRElemBaseModule) => KRSimplifySound_BaseModule
                | (KRTypeElem KRElemMod) => KRSimplifySound_Mod
                | (KRTypeList (KRTypeElem KRElemMod)) => KRSimplifySound_list_Mod
                | (KRTypeElem KRElemProp) => KRSimplifySound_ImplProp
                end in
  change e with (denote x);repeat (rewrite <- simplifySound;try (repeat (decide equality));cbv [
                sappend srev sdisjPrefix String.eqb Ascii.eqb Bool.eqb
                KRSimplify_RegInitT KRSimplifyTop_RegInitT
                KRSimplify_RegInitValT KRSimplifyTop_RegInitValT
                KRSimplify_Rule KRSimplifyTop_Rule
                KRSimplify_DefMethT KRSimplifyTop_DefMethT
                KRSimplify_ModuleElt KRSimplifyTop_ModuleElt
                KRSimplify_list_RegInitT KRSimplifyTop_list_RegInitT
                KRSimplify_list_Rule KRSimplifyTop_list_Rule
                KRSimplify_list_DefMethT KRSimplifyTop_list_DefMethT
                KRSimplify_list_ModuleElt KRSimplifyTop_list_ModuleElt
                KRSimplify_list_list_RegInitT KRSimplifyTop_list_list_RegInitT
                KRSimplify_list_list_Rule KRSimplifyTop_list_list_Rule
                KRSimplify_list_list_DefMethT KRSimplifyTop_list_list_DefMethT
                KRSimplify_list_list_ModuleElt KRSimplifyTop_list_list_ModuleElt
                KRSimplify_BaseModule KRSimplifyTop_BaseModule
                KRSimplify_RegFileBase KRSimplifyTop_RegFileBase
                KRSimplify_list_RegFileBase KRSimplifyTop_list_RegFileBase
                KRSimplify_string KRSimplifyTop_string
                KRSimplify_list_string KRSimplifyTop_list_string
                KRSimplify_list_list_string KRSimplifyTop_list_list_string
                KRSimplify_Mod KRSimplifyTop_Mod
                KRSimplify_Mod KRSimplifyTop_list_Mod
                KRSimplify_ImplProp KRSimplifyTop_ImplProp
                                  ]);
  cbv [
      sappend srev sdisjPrefix String.eqb Ascii.eqb Bool.eqb
                KRExprDenote_RegInitT
                KRExprDenote_RegInitValT
                KRExprDenote_Rule
                KRExprDenote_DefMethT
                KRExprDenote_ModuleElt
                KRExprDenote_list_RegInitT
                KRExprDenote_list_Rule
                KRExprDenote_list_DefMethT
                KRExprDenote_ActionVoid
                KRExprDenote_MethodT
                KRExprDenote_list_ModuleElt
                KRExprDenote_list_list_RegInitT
                KRExprDenote_list_list_Rule
                KRExprDenote_list_list_DefMethT
                KRExprDenote_list_list_ModuleElt
                KRExprDenote_BaseModule
                KRExprDenote_Mod
                KRExprDenote_list_Mod
                KRExprDenote_RegFileBase
                KRExprDenote_list_RegFileBase
                KRExprDenote_string
                KRExprDenote_list_string
                KRExprDenote_list_list_string
                KRExprDenote_Prop].

(*Ltac KRPrintReify e :=
  let x := (ltac:(KRExprReify e t)) in
  let t := eval compute in (KRTypeDenote x) in
  let xx := (ltac:(KRExprReify e t)) in
      idtac t;idtac x.
 *)

Goal forall a b c d e, Registers ([a;b]++[c;d])=e.
  intros.
  match goal with
  | |- ?A = ?B => KRSimplifyTac A (KRTypeList (KRTypeElem KRElemModuleElt))
  end.
Abort.
Goal forall a b c d e, makeModule_regs [MERegister a;MERule b;MEMeth c;MERegister d]=e.
  intros.
  match goal with
  | |- ?A = ?B =>
    (*let x := (ltac:(KRExprReify A (KRTypeList (KRTypeElem KRElemRegInitT)))) in
    idtac x*)
    KRSimplifyTac A (KRTypeList (KRTypeElem KRElemRegInitT))
  end.
Abort.
Goal forall a b c d e, makeModule_rules [MERegister a;MERule b;MEMeth c;MERegister d]=e.
  intros.
  match goal with
  | |- ?A = ?B =>
      KRSimplifyTac A (KRTypeList (KRTypeElem KRElemRule))
  end.
Abort.
Goal forall a b c d e, makeModule_meths [MEMeth a;MERule b;MERegister c;MERegister d]=e.
  intros.
  match goal with
  | |- ?A = ?B =>
      KRSimplifyTac A (KRTypeList (KRTypeElem KRElemDefMethT))
  end.
Abort.
Goal forall e, makeModule_regs []=e.
  intros.
  match goal with
  | |- ?A = ?B =>
      KRSimplifyTac A (KRTypeList (KRTypeElem KRElemRegInitT))
  end.
Abort.
Goal forall x, x \/ True.
  intros.
  match goal with
  | |- ?X => KRSimplifyTac X (KRTypeElem KRElemProp)
  end.
Abort.
Goal forall proc_name, ~(( proc_name ++ "_" ++ "a")%string = (proc_name ++ "_" ++  "b")%string).
  intros.
  match goal with
  | |- ~ ?A =>
    let x := (ltac:(KRExprReify (~A) (KRTypeElem KRElemProp))) in change (~A) with (KRExprDenote_Prop x)
  end.
  rewrite <- KRSimplifySound_ImplProp.
  cbv [
                KRSimplify_RegInitT KRSimplifyTop_RegInitT
                KRSimplify_RegInitValT KRSimplifyTop_RegInitValT
                KRSimplify_Rule KRSimplifyTop_Rule
                KRSimplify_DefMethT KRSimplifyTop_DefMethT
                KRSimplify_ModuleElt KRSimplifyTop_ModuleElt
                KRSimplify_list_RegInitT KRSimplifyTop_list_RegInitT
                KRSimplify_list_Rule KRSimplifyTop_list_Rule
                KRSimplify_list_DefMethT KRSimplifyTop_list_DefMethT
                KRSimplify_list_ModuleElt KRSimplifyTop_list_ModuleElt
                KRSimplify_list_list_RegInitT KRSimplifyTop_list_list_RegInitT
                KRSimplify_list_list_Rule KRSimplifyTop_list_list_Rule
                KRSimplify_list_list_DefMethT KRSimplifyTop_list_list_DefMethT
                KRSimplify_list_list_ModuleElt KRSimplifyTop_list_list_ModuleElt
                KRSimplify_BaseModule KRSimplifyTop_BaseModule
                KRSimplify_RegFileBase KRSimplifyTop_RegFileBase
                KRSimplify_list_RegFileBase KRSimplifyTop_list_RegFileBase
                KRSimplify_string KRSimplifyTop_string
                KRSimplify_list_string KRSimplifyTop_list_string
                KRSimplify_list_list_string KRSimplifyTop_list_list_string
                KRSimplify_Mod KRSimplifyTop_Mod
                KRSimplify_Mod KRSimplifyTop_list_Mod
                KRSimplify_ImplProp KRSimplifyTop_ImplProp
    ].
  cbv [         sappend srev sdisjPrefix
                KRExprDenote_RegInitT
                KRExprDenote_Rule
                KRExprDenote_DefMethT
                KRExprDenote_ModuleElt
                KRExprDenote_list_RegInitT
                KRExprDenote_list_Rule
                KRExprDenote_list_DefMethT
                KRExprDenote_list_ModuleElt
                KRExprDenote_list_list_RegInitT
                KRExprDenote_list_list_Rule
                KRExprDenote_list_list_DefMethT
                KRExprDenote_list_list_ModuleElt
                KRExprDenote_BaseModule
                KRExprDenote_Mod
                KRExprDenote_list_Mod
                KRExprDenote_RegFileBase
                KRExprDenote_list_RegFileBase
                KRExprDenote_string
                KRExprDenote_list_string
                KRExprDenote_list_list_string
                KRExprDenote_Prop].
Abort.


Require Import Bool List String Peano_dec Lia.
Require Import Common FMap IndexSupport HVector Syntax Topology Semantics SemFacts StepM.
Require Import Invariant TrsInv Simulation Serial SerialFacts.
Require Import RqRsLang RqRsCorrect.

Require Import Ex.Spec Ex.SpecInds Ex.Template.
Require Import Ex.Msi Ex.Msi.Msi.

Set Implicit Arguments.

Import PropMonadNotations.
Import CaseNotations.

Local Open Scope list.
Local Open Scope hvec.
Local Open Scope fmap.

#[global] Existing Instance Msi.ImplOStateIfc.

Section ObjInv.
  Variable topo: DTree.

  Definition MsiUpLockObjInv (oidx: IdxT): ObjInv :=
    fun ost orq =>
      (rqiu <+- orq@[upRq];
      rmsg <+- rqiu.(rqi_msg);
      match case rmsg.(msg_id) on idx_dec default True with
      | msiRqS:
          ost#[owned] = false /\ ost#[status] <= msiI /\
          ost#[dir].(dir_st) <= msiS
      | msiRqM:
          ost#[owned] = false /\ ost#[status] <= msiS /\
          ost#[dir].(dir_st) <= msiS
      end).

  Definition DownLockFromChild (oidx: IdxT) (rqid: RqInfo Msg) :=
    exists cidx,
      rqid.(rqi_midx_rsb) = Some (downTo cidx) /\
      parentIdxOf topo cidx = Some oidx.

  Definition DownLockFromParent (oidx: IdxT) (rqid: RqInfo Msg) :=
    rqid.(rqi_midx_rsb) = Some (rsUpFrom oidx).

  Definition MsiDownLockObjInv (oidx: IdxT): ObjInv :=
    fun ost orq =>
      (rqid <+- orq@[downRq];
      rmsg <+- rqid.(rqi_msg);
      match case rmsg.(msg_id) on idx_dec default True with
      | msiRqS: DownLockFromChild oidx rqid /\
                ost#[status] <= msiI /\ ost#[dir].(dir_st) = msiM /\
                In ost#[dir].(dir_excl) (subtreeChildrenIndsOf topo oidx) /\
                map fst rqid.(rqi_rss) = [rsUpFrom ost#[dir].(dir_excl)]
      | msiRqM: DownLockFromChild oidx rqid /\
                ost#[status] <= msiS /\
                ((ost#[owned] = true /\ ost#[dir].(dir_st) = msiS /\
                  SubList ost#[dir].(dir_sharers) (subtreeChildrenIndsOf topo oidx) /\
                  (rsb <+- rqid.(rqi_midx_rsb);
                  map fst rqid.(rqi_rss) =
                  map rsUpFrom (remove idx_dec (objIdxOf rsb) ost#[dir].(dir_sharers)))) \/
                 (ost#[dir].(dir_st) = msiM /\
                  In ost#[dir].(dir_excl) (subtreeChildrenIndsOf topo oidx) /\
                  map fst rqid.(rqi_rss) = [rsUpFrom ost#[dir].(dir_excl)]))
      | msiDownRqS: DownLockFromParent oidx rqid /\
                    ost#[status] <= msiI /\ ost#[dir].(dir_st) = msiM /\
                    In ost#[dir].(dir_excl) (subtreeChildrenIndsOf topo oidx) /\
                    map fst rqid.(rqi_rss) = [rsUpFrom ost#[dir].(dir_excl)]
      | msiDownRqIS: DownLockFromParent oidx rqid /\
                     ost#[dir].(dir_st) = msiS /\
                     SubList ost#[dir].(dir_sharers) (subtreeChildrenIndsOf topo oidx) /\
                     map fst rqid.(rqi_rss) = map rsUpFrom ost#[dir].(dir_sharers)
      | msiDownRqIM: DownLockFromParent oidx rqid /\
                     ((ost#[dir].(dir_st) = msiS /\
                       SubList ost#[dir].(dir_sharers) (subtreeChildrenIndsOf topo oidx) /\
                       map fst rqid.(rqi_rss) = map rsUpFrom ost#[dir].(dir_sharers)) \/
                      (ost#[dir].(dir_st) = msiM /\
                       In ost#[dir].(dir_excl) (subtreeChildrenIndsOf topo oidx) /\
                       map fst rqid.(rqi_rss) = [rsUpFrom ost#[dir].(dir_excl)]))
      end).

  Definition MsiObjInvs (oidx: IdxT): ObjInv :=
    fun ost orq =>
      MsiUpLockObjInv oidx ost orq /\
      MsiDownLockObjInv oidx ost orq.

End ObjInv.

Ltac disc_msi_obj_invs :=
  repeat
    match goal with
    | [H: MsiObjInvs _ _ _ _ |- _] => destruct H
    | [H: MsiUpLockObjInv _ _ _ |- _] =>
      red in H; mred; simpl in H; disc_rule_conds_const
    | [H: MsiDownLockObjInv _ _ _ _ |- _] =>
      red in H; mred; simpl in H; disc_rule_conds_const
    | [Hmsg: msg_id ?rmsg = _, H: context [msg_id ?rmsg] |- _] =>
      rewrite Hmsg in H; simpl in H
    end.


Require Import Bool Vector List String Peano_dec.
Require Import Common FMap HVector ListSupport IndexSupport.
Require Import Syntax Topology Semantics Invariant.
Require Import RqRsLang.

Require Import Ex.Spec Ex.SpecInds Ex.Template Ex.Mesi.
Require Import Ex.Mesi.Mesi Ex.Mesi.MesiObjInv.

Set Implicit Arguments.

Local Open Scope list.
Local Open Scope hvec.
Local Open Scope fmap.

Section System.
  Variable tr: tree.
  Hypothesis (Htr: tr <> Node nil).

  Local Notation topo := (fst (tree2Topo tr 0)).
  Local Notation cifc := (snd (tree2Topo tr 0)).
  Local Notation impl := (impl Htr).

  Hint Extern 0 (TreeTopo _) => apply tree2Topo_TreeTopo.
  Hint Extern 0 (WfDTree _) => apply tree2Topo_WfDTree.

  Lemma mesi_indices:
    map obj_idx (sys_objs impl) = c_li_indices cifc ++ c_l1_indices cifc.
  Proof.
    simpl; rewrite c_li_indices_head_rootOf at 2 by assumption.
    simpl; f_equal.
    rewrite map_app, map_map, map_id; simpl.
    rewrite map_map, map_id; reflexivity.
  Qed.

  Lemma mesi_GoodORqsInit: GoodORqsInit (initsOf impl).
  Proof.
    apply initORqs_GoodORqsInit.
  Qed.

  Lemma mesi_WfDTree: WfDTree topo.
  Proof.
    apply tree2Topo_WfDTree.
  Qed.

  Lemma mesi_RqRsChnsOnDTree: RqRsChnsOnDTree topo.
  Proof.
    apply tree2Topo_RqRsChnsOnDTree.
  Qed.

  Lemma mesi_RqRsChnsOnSystem: RqRsChnsOnSystem topo impl.
  Proof.
    eapply tree2Topo_RqRsChnsOnSystem with (tr0:= tr) (bidx:= [0]); try reflexivity.
    - destruct (tree2Topo _ _); reflexivity.
    - simpl.
      rewrite map_app.
      do 2 rewrite map_trans.
      do 2 rewrite map_id.
      rewrite app_comm_cons.
      rewrite <-c_li_indices_head_rootOf by assumption.
      reflexivity.
  Qed.

  Lemma mesi_ExtsOnDTree: ExtsOnDTree topo impl.
  Proof.
    eapply tree2Topo_ExtsOnDTree with (tr0:= tr) (bidx:= [0]); try reflexivity.
    destruct (tree2Topo _ _); reflexivity.
  Qed.

  Lemma mesi_RqRsDTree: RqRsDTree topo impl.
  Proof.
    red; repeat ssplit.
    - auto using mesi_WfDTree.
    - auto using mesi_RqRsChnsOnDTree.
    - auto using mesi_RqRsChnsOnSystem.
    - auto using mesi_ExtsOnDTree.
  Qed.

  Ltac solve_GoodRqRsRule_unfold ::= autounfold with MesiRules.

  Lemma mesi_GoodRqRsSys: GoodRqRsSys topo impl.
  Proof.
    repeat
      match goal with
      | |- GoodRqRsSys _ _ => red
      | |- GoodRqRsObj _ _ _ => red
      | |- Forall _ _ => simpl; constructor; simpl
      | |- Forall _ (_ ++ _) => apply Forall_app
      end.

    - (** Main memory *)

      assert (In (rootOf topo) (c_li_indices cifc)) as Hrin.
      { rewrite c_li_indices_head_rootOf by assumption.
        left; reflexivity.
      }

      simpl.
      repeat
        match goal with
        | |- Forall _ (_ ++ _) => apply Forall_app
        | |- Forall _ (_ :: _) => constructor
        | |- Forall _ nil => constructor
        end.

      apply Forall_forall; intros.
      unfold liRulesFromChildren in H.
      apply concat_In in H; dest.
      apply in_map_iff in H; dest; subst.
      dest_in.
      all: try (solve_GoodRqRsRule; fail).

    - (** Li caches *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; simpl.

      (* pre-register a fact: an Li cache always has a parent *)
      pose proof (c_li_l1_indices_has_parent
                    Htr _ _ (in_or_app _ _ _ (or_introl H0))).
      destruct H as [pidx ?].

      repeat
        match goal with
        | |- Forall _ (_ ++ _) => apply Forall_app
        | |- Forall _ (_ :: _) => constructor
        | |- Forall _ nil => constructor
        end.
      all: try (solve_GoodRqRsRule; fail).

      1: {
        apply Forall_forall; intros.
        unfold liRulesFromChildren in H1.
        apply concat_In in H1; dest.
        apply in_map_iff in H1; dest; subst.
        dest_in.
        all: try (solve_GoodRqRsRule; fail).

        { (* [liGetSRqUpDownME] *)
          apply subtreeChildrenIndsOf_parentIdxOf in H3; [|apply tree2Topo_WfDTree].
          pose proof (tree2Topo_li_child_li_l1 _ _ _ (tl_In _ _ H0) H3).
          rewrite <-mesi_indices in H1.

          rule_rqud; eapply rqUpDownRule_RqFwdRule; eauto.

          (** [RqUpDownSound] *)
          red; simpl; intros; dest.
          apply subtreeChildrenIndsOf_parentIdxOf in H4; [|apply tree2Topo_WfDTree].
          repeat ssplit; [discriminate| |intuition auto].
          repeat constructor; try assumption.
        }

        { (* [liGetMRqUpDownME] *)
          apply subtreeChildrenIndsOf_parentIdxOf in H3; [|apply tree2Topo_WfDTree].
          pose proof (tree2Topo_li_child_li_l1 _ _ _ (tl_In _ _ H0) H3).
          rewrite <-mesi_indices in H1.

          rule_rqud; eapply rqUpDownRule_RqFwdRule; eauto.

          (** [RqUpDownSound] *)
          red; simpl; intros; dest.
          apply subtreeChildrenIndsOf_parentIdxOf in H4; [|apply tree2Topo_WfDTree].
          repeat ssplit; [discriminate| |intuition auto].
          repeat constructor; try assumption.
        }

        { (* [liGetMRqUpDownS] *)
          apply subtreeChildrenIndsOf_parentIdxOf in H3; [|apply tree2Topo_WfDTree].
          pose proof (tree2Topo_li_child_li_l1 _ _ _ (tl_In _ _ H0) H3).
          rewrite <-mesi_indices in H1.

          rule_rqud; eapply rqUpDownRule_RqFwdRule; eauto.

          (** [RqUpDownSound] *)
          red; simpl; intros; dest.
          repeat ssplit.
          { assumption. }
          { apply Forall_forall; intros.
            apply in_remove in H9.
            apply H4 in H9.
            eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
          }
          { apply remove_In. }
        }
      }

      { (* [liDownSRqDownDownME] *)
        rule_rqdd.
        eapply rqDownDownRule_RqFwdRule; eauto.

        (** [RqDownDownSound] *)
        red; simpl; intros; dest.
        repeat ssplit; [discriminate|].
        repeat constructor.
        eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
      }

      { (* [liGetMRsDownRqDownDirS] *)
        rule_rsrq; eapply rsDownRqDownRule_RsDownRqDownRule; eauto.

        (** [RsDownRqDownSound] *)
        red; simpl; intros; dest.
        red in H1.
        unfold getUpLockIdxBackI, getUpLockIdxBack in *.
        destruct (orq@[upRq]) as [rqiu|]; simpl in *; auto.
        destruct H1 as [rcidx [rqUp ?]]; dest.
        pose proof (tree2Topo_li_child_li_l1 _ _ _ (tl_In _ _ H0) H1).
        rewrite <-mesi_indices in H9.
        intros; rewrite H11 in *.
        repeat ssplit.
        { assumption. }
        { apply Forall_forall; intros.
          apply in_remove in H12.
          apply H3 in H12.
          eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
        }
        { exists rcidx, rqUp.
          repeat split; try assumption.
        }
      }

      { (* [liDownIRqDownDownDirS] *)
        rule_rqdd.
        eapply rqDownDownRule_RqFwdRule; eauto.

        (** [RqDownDownSound] *)
        red; simpl; intros; dest.
        repeat ssplit; [assumption|].
        apply Forall_forall; intros.
        apply H2 in H4.
        eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
      }

      { (* [liDownIRqDownDownDirME] *)
        rule_rqdd.
        eapply rqDownDownRule_RqFwdRule; eauto.

        (** [RqDownDownSound] *)
        red; simpl; intros; dest.
        repeat ssplit; [discriminate|].
        repeat constructor.
        eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
      }

      { (* [liDownIRqDownDownDirMES] *)
        rule_rqdd.
        eapply rqDownDownRule_RqFwdRule; eauto.

        (** [RqDownDownSound] *)
        red; simpl; intros; dest.
        repeat ssplit; [assumption|].
        apply Forall_forall; intros.
        apply H2 in H4.
        eapply subtreeChildrenIndsOf_parentIdxOf; eauto.
      }

    - (** L1 caches *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; simpl.

      (* pre-register a fact: an L1 cache always has a parent *)
      pose proof (c_li_l1_indices_has_parent
                    Htr _ _ (in_or_app _ _ _ (or_intror H0))).
      destruct H as [pidx ?].

      repeat
        match goal with
        | |- Forall _ (_ ++ _) => apply Forall_app
        | |- Forall _ (_ :: _) => constructor
        | |- Forall _ nil => constructor
        end.
      all: try (solve_GoodRqRsRule; fail).
  Qed.

  Ltac exfalso_RqToUpRule_unfold ::= repeat autounfold with MesiRules in *.
  Ltac exfalso_RsToUpRule_unfold ::= repeat autounfold with MesiRules in *.
  Ltac disc_rule_custom ::= disc_mesi_obj_invs.

  Lemma mesi_RqUpRsUpOkSys: RqUpRsUpOkSys topo impl (MesiObjInvs topo).
  Proof. (* SKIP_PROOF_ON
    repeat
      match goal with
      | |- RqUpRsUpOkSys _ _ _ => red
      | |- Forall _ _ => simpl; constructor; simpl
      | |- Forall _ (_ ++ _) => apply Forall_app
      end.

    - (** The main memory: no RqUp rules *)
      red; intros.
      simpl in H; unfold liRulesFromChildren in H.
      apply concat_In in H; dest.
      apply in_map_iff in H; dest; subst.
      dest_in.
      all: try (exfalso_RqToUpRule; fail).

    - (** Li cache *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; intros.

      simpl in H; apply in_app_or in H; destruct H;
        [unfold liRulesFromChildren in H;
         apply concat_In in H; dest;
         apply in_map_iff in H; dest; subst;
         dest_in|dest_in].
      all: try (exfalso_RqToUpRule; fail).

      + simpl in H2; apply in_app_or in H2; destruct H2;
          [unfold liRulesFromChildren in H;
           apply concat_In in H; dest;
           apply in_map_iff in H; dest; subst;
           dest_in|dest_in].
        all: try (exfalso_RsToUpRule; fail).

        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; auto.
          { destruct H17; dest; try solve [congruence|solve_mesi]. }
          { destruct H17; dest; try solve [congruence|solve_mesi]. }
        }
        { clear; solve_rule_conds_ex; auto.
          { destruct H17; dest; try solve [congruence|solve_mesi]. }
          { destruct H17; dest; try solve [congruence|solve_mesi]. }
        }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi.
          f_equal; apply M.add_remove_comm; discriminate.
        }
        { clear; solve_rule_conds_ex; try solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi.
          f_equal; apply M.add_remove_comm; discriminate.
        }

      + simpl in H2; apply in_app_or in H2; destruct H2;
          [unfold liRulesFromChildren in H;
           apply concat_In in H; dest;
           apply in_map_iff in H; dest; subst;
           dest_in|dest_in].
        all: try (exfalso_RsToUpRule; fail).

        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi.
          all: try (destruct H17; dest; try solve [congruence|solve_mesi]).
        }
        { clear; solve_rule_conds_ex; try solve_mesi.
          all: try (destruct H17; dest; try solve [congruence|solve_mesi]).
        }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi.
          f_equal; apply M.add_remove_comm; discriminate.
        }
        { clear; solve_rule_conds_ex; try solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi.
          f_equal; apply M.add_remove_comm; discriminate.
        }

      + simpl in H2; apply in_app_or in H2; destruct H2;
          [unfold liRulesFromChildren in H;
           apply concat_In in H; dest;
           apply in_map_iff in H; dest; subst;
           dest_in|dest_in].
        all: try (exfalso_RsToUpRule; fail).

        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_const; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_const.
          all: rewrite invalidate_I; solve_mesi.
        }
        { clear; solve_rule_conds_const; try solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi. }
        { clear; solve_rule_conds_ex; try solve_mesi. }

      + simpl in H2; apply in_app_or in H2; destruct H2;
          [unfold liRulesFromChildren in H;
           apply concat_In in H; dest;
           apply in_map_iff in H; dest; subst;
           dest_in|dest_in].
        all: try (exfalso_RsToUpRule; fail).

        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_const; try intuition solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_const.
          rewrite invalidate_I; [|solve_mesi].
          intuition solve_mesi.
        }
        { clear; solve_rule_conds_const; try intuition solve_mesi. }
        { clear; solve_rule_conds_ex; solve_mesi. }
        { clear; solve_rule_conds_ex; try intuition solve_mesi. }
        { clear; solve_rule_conds_ex; try intuition solve_mesi. }

    - (** L1 cache *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; intros.

      phide H2; dest_in.
      all: try (exfalso_RqToUpRule; fail).

      + preveal H4; dest_in.
        all: try (exfalso_RsToUpRule; fail).
        { clear; solve_rule_conds_const; solve_mesi. }
        { clear; solve_rule_conds_const; auto. }
        { clear; solve_rule_conds_const; auto. }

      + preveal H4; dest_in.
        all: try (exfalso_RsToUpRule; fail).
        { clear; solve_rule_conds_const. }
        { clear; solve_rule_conds_const; solve_mesi. }
        { clear; solve_rule_conds_const; solve_mesi. }

      + preveal H4; dest_in.
        all: try (exfalso_RsToUpRule; fail).
        { clear; solve_rule_conds_const; try solve_mesi. }
        { clear; solve_rule_conds_const.
          all: rewrite invalidate_I; solve_mesi.
        }
        { clear; solve_rule_conds_const.
          all: rewrite invalidate_I; solve_mesi.
        }

      + preveal H4; dest_in.
        all: try (exfalso_RsToUpRule; fail).
        { clear; solve_rule_conds_const; try solve_mesi. }
        { clear; solve_rule_conds_const.
          rewrite invalidate_I; solve_mesi.
        }
        { clear; solve_rule_conds_const.
          rewrite invalidate_I; solve_mesi.
        }

        END_SKIP_PROOF_ON *) admit.
  Qed.

  Lemma mesi_GoodExtRssSys: GoodExtRssSys impl.
  Proof. (* SKIP_PROOF_ON
    red; simpl.
    constructor; [|apply Forall_app].
    - (** the main memory *)
      red; simpl.
      apply Forall_forall; intros.
      unfold memRulesFromChildren in H.
      apply concat_In in H; dest.
      apply in_map_iff in H; dest; subst.
      dest_in.
      all: try (red; simpl; disc_rule_conds_ex; solve_GoodExtRssSys; fail).

    - (** Li cache *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; simpl.
      apply Forall_app.

      + apply Forall_forall; intros.
        unfold liRulesFromChildren in H.
        apply concat_In in H; dest.
        apply in_map_iff in H; dest; subst.
        dest_in.
        all: try (red; simpl; disc_rule_conds_ex; solve_GoodExtRssSys; fail).
        { (* [liGetMRqUpDownS] *)
          red; simpl; disc_rule_conds_ex.
          apply in_map_iff in H3; dest; subst.
          apply in_remove in H12.
          apply H5 in H12.
          simpl in *; solve_GoodExtRssSys.
        }

      + repeat constructor.
        all: try (red; simpl; disc_rule_conds_ex; solve_GoodExtRssSys; fail).
        { (* [liGetMRsDownRqDownDirS] *)
          red; simpl; disc_rule_conds_ex.
          apply in_map_iff in H2; dest; subst.
          apply in_remove in H5.
          apply H11 in H5.
          simpl in *; solve_GoodExtRssSys.
        }
        { (* [liDownIRqDownDownDirS] *)
          red; simpl; disc_rule_conds_ex.
          apply in_map_iff in H2; dest; subst.
          apply H4 in H7.
          simpl in *; solve_GoodExtRssSys.
        }
        { (* [liDownIRqDownDownDirMES] *)
          red; simpl; disc_rule_conds_ex.
          apply in_map_iff in H2; dest; subst.
          apply H4 in H7.
          simpl in *; solve_GoodExtRssSys.
        }

    - (** L1 cache *)
      apply Forall_forall; intros.
      apply in_map_iff in H.
      destruct H as [oidx [? ?]]; subst.
      red; simpl.
      repeat constructor.
      all: try (red; simpl; disc_rule_conds_ex; solve_GoodExtRssSys; fail).

      END_SKIP_PROOF_ON *) admit.
  Qed.

  Lemma mesi_GoodRqRsInterfSys: GoodRqRsInterfSys topo impl (MesiObjInvs topo).
  Proof.
    split.
    - apply mesi_RqUpRsUpOkSys.
    - apply mesi_GoodExtRssSys.
  Qed.

  Lemma mesi_RqRsSys: RqRsSys topo impl (MesiObjInvs topo).
  Proof.
    red; repeat ssplit.
    - apply mesi_RqRsDTree.
    - apply mesi_GoodRqRsSys.
    - apply mesi_GoodRqRsInterfSys.
  Qed.

End System.

#[global] Hint Resolve mesi_GoodORqsInit mesi_WfDTree mesi_RqRsDTree mesi_RqRsSys.