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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import MemoryFacts.

Require Import Cover.

Set Implicit Arguments.

Module MemoryReorder.
  Lemma add_add
        mem0 loc1 from1 to1 msg1
        mem1 loc2 from2 to2 msg2
        mem2
        (ADD1: Memory.add mem0 loc1 from1 to1 msg1 mem1)
        (ADD2: Memory.add mem1 loc2 from2 to2 msg2 mem2):
    exists mem1',
      <<ADD1: Memory.add mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<ADD2: Memory.add mem1' loc1 from1 to1 msg1 mem2>> /\
      <<LOCTS: (loc1, to1) <> (loc2, to2)>>.
  Proof.
    exploit (@Memory.add_exists mem0 loc2 from2 to2).
    { i. inv ADD2. inv ADD. eapply DISJOINT.
      etrans; [eapply Memory.add_o; eauto|]. condtac; ss; eauto.
      des. subst. exploit Memory.add_get0; eauto. i. des. congr.
    }
    { inv ADD2. inv ADD. auto. }
    { inv ADD2. inv ADD. eauto. }
    i. des.
    exploit (@Memory.add_exists mem3 loc1 from1 to1).
    { i. revert GET2. erewrite Memory.add_o; eauto. condtac; ss.
      - des. subst. i. inv GET2.
        exploit Memory.add_get0; try exact ADD2; eauto.
        inv ADD2. inv ADD. symmetry. eapply DISJOINT.
        etrans; [eapply Memory.add_o; eauto|]. condtac; ss. des; congr.
      - guardH o. i. inv ADD1. inv ADD. eapply DISJOINT; eauto.
    }
    { inv ADD1. inv ADD. auto. }
    { inv ADD1. inv ADD. eauto. }
    i. des.
    esplits; eauto; cycle 1.
    { ii. inv H.
      exploit Memory.add_get0; try exact ADD2; eauto.
      erewrite Memory.add_o; eauto. condtac; s; i; des; congr.
    }
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    setoid_rewrite Memory.add_o; cycle 1; eauto.
    erewrite (@Memory.add_o mem3); eauto. erewrite (@Memory.add_o mem1); eauto.
    repeat (condtac; ss). des. subst.
    exploit Memory.add_get0; try exact ADD1; eauto. i. des.
    exploit Memory.add_get0; try exact ADD2; eauto. i. des.
    congr.
  Qed.

  Lemma add_split_same
        mem0 loc ts1 ts2 ts3 msg2 msg3 mem1 mem2
        (ADD1: Memory.add mem0 loc ts1 ts3 msg3 mem1)
        (SPLIT2: Memory.split mem1 loc ts1 ts2 ts3 msg2 msg3 mem2):
    exists mem1',
      <<ADD1: Memory.add mem0 loc ts1 ts2 msg2 mem1'>> /\
      <<ADD2: Memory.add mem1' loc ts2 ts3 msg3 mem2>>.
  Proof.
    exploit (@Memory.add_exists mem0 loc ts1 ts2 msg2); eauto.
    { i. inv ADD1. inv ADD. hexploit DISJOINT; eauto. i.
      eapply Interval.le_disjoint; eauto. econs; [refl|].
      inv SPLIT2. inv SPLIT. left. auto.
    }
    { inv SPLIT2. inv SPLIT. auto. }
    { inv SPLIT2. inv SPLIT. auto. }
    i. des.
    exploit (@Memory.add_exists mem3 loc ts2 ts3 msg3); eauto.
    { i. revert GET2. erewrite Memory.add_o; eauto. condtac; ss.
      - des. subst. i. inv GET2.
        symmetry. apply Interval.disjoint_imm.
      - i. inv ADD1. inv ADD. hexploit DISJOINT; eauto. i.
        eapply Interval.le_disjoint; eauto. econs; [|refl].
        inv SPLIT2. inv SPLIT. left. auto.
    }
    { inv SPLIT2. inv SPLIT. auto. }
    { inv ADD1. inv ADD. auto. }
    i. des.
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.add_o; eauto. erewrite Memory.add_o; eauto.
    erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.add_o mem1); eauto.
    repeat (condtac; ss). des. repeat subst.
    inv SPLIT2. inv SPLIT. exfalso. eapply Time.lt_strorder. eauto.
  Qed.

  Lemma add_split
        mem0 loc1 from1 to1 msg1
        mem1 loc2 ts21 ts22 ts23 msg22 msg23
        mem2
        (ADD1: Memory.add mem0 loc1 from1 to1 msg1 mem1)
        (SPLIT2: Memory.split mem1 loc2 ts21 ts22 ts23 msg22 msg23 mem2):
    (loc1 = loc2 /\ from1 = ts21 /\ to1 = ts23 /\ msg1 = msg23 /\
     exists mem1',
       <<ADD1: Memory.add mem0 loc2 ts21 ts22 msg22 mem1'>> /\
       <<ADD2: Memory.add mem1' loc2 ts22 ts23 msg23 mem2>>) \/
    (<<LOCTS1: (loc1, to1) <> (loc2, ts23)>> /\
     exists mem1',
       <<SPLIT1: Memory.split mem0 loc2 ts21 ts22 ts23 msg22 msg23 mem1'>> /\
       <<ADD2: Memory.add mem1' loc1 from1 to1 msg1 mem2>>).
  Proof.
    exploit Memory.split_get0; eauto. i. des.
    revert GET0. erewrite Memory.add_o; eauto. condtac; ss.
    { des. i. inv GET0. left. splits; eauto.
      eapply add_split_same; eauto.
    }
    guardH o. i. right. splits.
    { ii. inv H. unguardH o. des; congr. }
    exploit (@Memory.split_exists mem0 loc2 ts21 ts22 ts23);
      try by inv SPLIT2; inv SPLIT; eauto.
    i. des.
    exploit (@Memory.add_exists mem3 loc1 from1 to1);
      try by inv ADD1; inv ADD; eauto.
    { i. revert GET3. erewrite Memory.split_o; eauto. repeat condtac; ss.
      - des. subst. i. inv GET3.
        inv ADD1. inv ADD. hexploit DISJOINT; eauto. i. symmetry in H.
        symmetry. eapply Interval.le_disjoint; eauto. econs; [refl|].
        inv SPLIT2. inv SPLIT. left. auto.
      - guardH o0. i. des. inv GET3.
        inv ADD1. inv ADD. hexploit DISJOINT; eauto. i. symmetry in H.
        symmetry. eapply Interval.le_disjoint; eauto. econs; [|refl].
        inv SPLIT2. inv SPLIT. left. auto.
      - guardH o0. i. inv ADD1. inv ADD. eapply DISJOINT; eauto.
    }
    i. des.
    esplits; eauto.
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.add_o; eauto. erewrite Memory.split_o; eauto.
    setoid_rewrite Memory.split_o; cycle 1; eauto.
    erewrite (@Memory.add_o mem1); eauto.
    repeat (condtac; ss).
    - des. repeat subst.
      exploit Memory.add_get0; try exact ADD1; eauto. i. des.
      exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
      congr.
    - guardH o0. des. repeat subst. unguardH o. des; congr.
  Qed.

  Lemma add_lower
        mem0 loc1 from1 to1 msg1
        mem1 loc2 from2 to2 msg2 msg2'
        mem2
        (ADD1: Memory.add mem0 loc1 from1 to1 msg1 mem1)
        (LOWER2: Memory.lower mem1 loc2 from2 to2 msg2 msg2' mem2):
    (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ msg1 = msg2 /\
     Memory.add mem0 loc1 from1 to1 msg2' mem2) \/
    (<<LOCTS1: (loc1, to1) <> (loc2, to2)>> /\
     exists mem1',
       <<LOWER1: Memory.lower mem0 loc2 from2 to2 msg2 msg2' mem1'>> /\
       <<ADD2: Memory.add mem1' loc1 from1 to1 msg1 mem2>>).
  Proof.
    exploit Memory.lower_get0; eauto.
    erewrite Memory.add_o; eauto. condtac; ss.
    - des. subst. i. des. inv GET. left. splits; eauto.
      inv ADD1. inv ADD. inv LOWER2. inv LOWER.
      rewrite LocFun.add_add_eq. econs; auto.
      unfold Cell.add in *.
      destruct r, r0. ss. subst.
      unfold LocFun.add. condtac; [|congr]. s.
      rewrite DOMap.add_add_eq. econs; auto.
    - guardH o. i. des. right. splits.
      { ii. inv H. unguardH o. des; congr. }
      exploit (@Memory.lower_exists mem0 loc2 from2 to2);
        try by inv LOWER2; inv LOWER; eauto.
      i. des.
      exploit (@Memory.add_exists mem3 loc1 from1 to1).
      { i. revert GET2. erewrite Memory.lower_o; eauto. condtac; ss.
        - des. subst. i. inv GET2.
          exploit Memory.lower_get0; eauto. i. des.
          inv ADD1. inv ADD. eapply DISJOINT. eauto.
        - guardH o0. i. inv ADD1. inv ADD. eapply DISJOINT; eauto.
      }
      { inv ADD1. inv ADD. auto. }
      { inv ADD1. inv ADD. eauto. }
      i. des.
      esplits; eauto.
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.add_o; eauto. erewrite Memory.lower_o; eauto.
      setoid_rewrite Memory.lower_o; cycle 1; eauto.
      erewrite (@Memory.add_o mem1); eauto.
      repeat (condtac; ss). des. repeat subst.
      unguardH o. des; congr.
  Qed.

  Lemma add_remove
        mem0 loc1 from1 to1 msg1
        mem1 loc2 from2 to2 msg2
        mem2
        (LOCTS1: (loc1, to1) <> (loc2, to2))
        (ADD1: Memory.add mem0 loc1 from1 to1 msg1 mem1)
        (REMOVE2: Memory.remove mem1 loc2 from2 to2 msg2 mem2):
    exists mem1',
      <<REMOVE1: Memory.remove mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<ADD2: Memory.add mem1' loc1 from1 to1 msg1 mem2>>.
  Proof.
    exploit (@Memory.remove_exists mem0 loc2 from2 to2).
    { hexploit Memory.remove_get0; eauto.
      erewrite Memory.add_o; eauto. condtac; ss; i; des; subst; eauto. congr.
    }
    i. des.
    exploit (@Memory.add_exists mem3 loc1 from1 to1);
      try by inv ADD1; inv ADD; eauto.
    { i. revert GET2. erewrite Memory.remove_o; eauto. condtac; ss.
      inv ADD1. inv ADD. eauto.
    }
    i. des.
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.add_o; eauto. erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o mem2); eauto. erewrite (@Memory.add_o mem1); eauto.
    repeat (condtac; ss). des. repeat subst. congr.
  Qed.

  Lemma add_remove_same
        mem0 loc1 from1 to1 msg1
        mem1 from2 msg2
        mem2
        (ADD1: Memory.add mem0 loc1 from1 to1 msg1 mem1)
        (REMOVE2: Memory.remove mem1 loc1 from2 to1 msg2 mem2):
    from1 = from2 /\ msg1 = msg2 /\ mem0 = mem2.
  Proof.
    exploit Memory.add_get0; eauto. i. des.
    exploit Memory.remove_get0; eauto. i. des.
    rewrite GET0 in *. inv GET1. splits; auto.
    apply Memory.ext. i.
    erewrite (@Memory.remove_o mem2); eauto. condtac; ss.
    - des. subst. ss.
    - erewrite (@Memory.add_o mem1); eauto. condtac; ss.
  Qed.

  Lemma split_add
        mem0 loc1 ts11 ts12 ts13 msg12 msg13
        mem1 loc2 from2 to2 msg2
        mem2
        (SPLIT1: Memory.split mem0 loc1 ts11 ts12 ts13 msg12 msg13 mem1)
        (ADD2: Memory.add mem1 loc2 from2 to2 msg2 mem2):
    <<LOCTS1: (loc1, ts12) <> (loc2, to2)>> /\
    <<LOCTS2: (loc1, ts13) <> (loc2, to2)>> /\
    exists mem1',
      <<ADD1: Memory.add mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<SPLIT2: Memory.split mem1' loc1 ts11 ts12 ts13 msg12 msg13 mem2>>.
  Proof.
    exploit (@Memory.add_exists mem0 loc2 from2 to2);
      try by inv ADD2; inv ADD; eauto.
    { apply covered_disjoint_get_disjoint. i. rewrite <- split_covered in H; eauto.
      eapply get_disjoint_covered_disjoint; eauto. inv ADD2. inv ADD. auto.
    }
    i. des.
    exploit (@Memory.split_exists mem3 loc1 ts11 ts12 ts13);
      try by inv SPLIT1; inv SPLIT; eauto.
    { erewrite Memory.add_o; eauto. condtac; ss.
      - des. subst.
        hexploit Memory.add_get0; try exact ADD2; eauto. i. des.
        revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
      - guardH o. hexploit Memory.split_get0; eauto. i. des. eauto.
    }
    i. des.
    splits.
    { ii. inv H.
      hexploit Memory.add_get0; try exact ADD2; eauto. i. des.
      revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
      guardH o0. des; congr.
    }
    { ii. inv H.
      hexploit Memory.add_get0; try exact ADD2; eauto. i. des.
      revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
      guardH o. des; congr.
    }
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.split_o; eauto. erewrite Memory.add_o; eauto.
    erewrite (@Memory.add_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
    repeat (condtac; ss).
    - des. repeat subst.
      hexploit Memory.add_get0; try exact ADD2; eauto. i. des.
      revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
    - guardH o. des. repeat subst.
      hexploit Memory.add_get0; try exact ADD2; eauto. i. des.
      revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
  Qed.

  Lemma split_split
        mem0 loc1 ts11 ts12 ts13 msg12 msg13
        mem1 loc2 ts21 ts22 ts23 msg22 msg23
        mem2
        (LOCTS1: (loc1, ts13) <> (loc2, ts23))
        (SPLIT1: Memory.split mem0 loc1 ts11 ts12 ts13 msg12 msg13 mem1)
        (SPLIT2: Memory.split mem1 loc2 ts21 ts22 ts23 msg22 msg23 mem2):
    (loc1 = loc2 /\ ts21 = ts11 /\ ts23 = ts12 /\
     exists mem1',
       <<SPLIT1: Memory.split mem0 loc2 ts21 ts22 ts13 msg22 msg13 mem1'>> /\
       <<SPLIT2: Memory.split mem1' loc1 ts22 ts12 ts13 msg12 msg13 mem2>>) \/
    ((loc2, ts21, ts23) <> (loc1, ts11, ts12) /\
     exists mem1',
       <<SPLIT1: Memory.split mem0 loc2 ts21 ts22 ts23 msg22 msg23 mem1'>> /\
       <<SPLIT2: Memory.split mem1' loc1 ts11 ts12 ts13 msg12 msg13 mem2>>).
  Proof.
    exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
    revert GET0. erewrite Memory.split_o; eauto. repeat condtac; ss.
    - i. des. inv GET0. left. splits; auto.
      exploit Memory.split_get0; try exact SPLIT1; eauto. i. des.
      exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
      revert GET4. erewrite Memory.split_o; eauto. condtac; ss.
      exploit (@Memory.split_exists mem0 loc1 ts21 ts22 ts13);
        try by inv SPLIT2; inv SPLIT; eauto.
      { etrans.
        - inv SPLIT2. inv SPLIT. eauto.
        - inv SPLIT1. inv SPLIT. eauto.
      }
      i. des.
      exploit (@Memory.split_exists mem3 loc1 ts22 ts12 ts13);
        (try by inv SPLIT1; inv SPLIT; eauto);
        (try by inv SPLIT2; inv SPLIT; eauto).
      { erewrite Memory.split_o; eauto. repeat condtac; ss.
        - des. subst. inv x0. inv SPLIT.
          exfalso. eapply Time.lt_strorder. eauto.
        - guardH o. des; congr.
      }
      i. des.
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.split_o; eauto. erewrite Memory.split_o; eauto.
      erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
      repeat (condtac; ss).
      + des. repeat subst. inv x1. inv SPLIT.
        exfalso. eapply Time.lt_strorder. eauto.
      + guardH o. des. repeat subst. inv x0. inv SPLIT.
        exfalso. eapply Time.lt_strorder. eauto.
    - guardH o. i. des. inv GET0. congr.
    - guardH o. guardH o0. i. right.
      exploit (@Memory.split_exists mem0 loc2 ts21 ts22 ts23);
        try by inv SPLIT2; inv SPLIT; eauto. i. des.
      exploit (@Memory.split_exists mem3 loc1 ts11 ts12 ts13);
        try by inv SPLIT1; inv SPLIT; eauto.
      { erewrite Memory.split_o; eauto. repeat condtac; ss.
        - des. subst. hexploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
          revert GET3. erewrite Memory.split_o; eauto. repeat condtac; ss.
        - guardH o1. des. subst. unguardH o0. des; congr.
        - guardH o1. guardH o2. hexploit Memory.split_get0; try exact SPLIT1; eauto. i. des. eauto.
      }
      i. des. splits.
      { ii. inv H. unguardH o. des; congr. }
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.split_o; eauto. erewrite Memory.split_o; eauto.
      erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
      repeat (condtac; ss).
      + des. repeat subst.
        exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
        revert GET3. erewrite Memory.split_o; eauto. repeat condtac; ss.
      + guardH o1. des. repeat subst. unguardH o. des; congr.
      + guardH o1. des. repeat subst.
        exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
        revert GET3. erewrite Memory.split_o; eauto. repeat condtac; ss.
      + guardH o1. guardH o2. des. repeat subst. unguardH o0. des; congr.
  Qed.

  Lemma split_lower_diff
        mem0 loc1 ts11 ts12 ts13 msg12 msg13
        mem1 loc2 from2 to2 msg2 msg2'
        mem2
        (LOCTS1: (loc1, ts13) <> (loc2, to2))
        (SPLIT1: Memory.split mem0 loc1 ts11 ts12 ts13 msg12 msg13 mem1)
        (LOWER2: Memory.lower mem1 loc2 from2 to2 msg2 msg2' mem2):
    (loc1 = loc2 /\ ts11 = from2 /\ ts12 = to2 /\ msg12 = msg2 /\
     Memory.split mem0 loc1 ts11 ts12 ts13 msg2' msg13 mem2) \/
    ((loc1, ts12) <> (loc2, to2) /\
     exists mem1',
        <<LOWER1: Memory.lower mem0 loc2 from2 to2 msg2 msg2' mem1'>> /\
        <<SPLIT2: Memory.split mem1' loc1 ts11 ts12 ts13 msg12 msg13 mem2>>).
  Proof.
    exploit Memory.lower_get0; eauto. i. des.
    revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
    - des. subst. i. inv GET. left. splits; auto.
      inv SPLIT1. inv SPLIT. inv LOWER2. inv LOWER.
      rewrite LocFun.add_add_eq. econs; auto.
      unfold Cell.split in *.
      destruct r, r0. ss. subst.
      unfold LocFun.add. condtac; [|congr]. s.
      rewrite DOMap.add_add_eq. econs; auto.
    - guardH o. des. subst. congr.
    - guardH o. guardH o0. i. right.
      exploit (@Memory.lower_exists mem0 loc2 from2 to2);
        try by inv LOWER2; inv LOWER; eauto. i. des.
      exploit (@Memory.split_exists mem3 loc1 ts11 ts12 ts13);
        try by inv SPLIT1; inv SPLIT; eauto.
      { erewrite Memory.lower_o; eauto. condtac; ss.
        - des. subst. congr.
        - guardH o1. hexploit Memory.split_get0; try exact SPLIT1; eauto. i. des. eauto.
      }
      i. des.
      splits.
      { ii. inv H. exploit Memory.split_get0; try exact SPLIT1; eauto. i. des.
        exploit Memory.lower_get0; eauto. i. des. congr.
      }
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.split_o; eauto. erewrite Memory.lower_o; eauto.
      erewrite (@Memory.lower_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
      repeat (condtac; ss).
      + des. repeat subst. congr.
      + guardH o1. des. repeat subst. congr.
  Qed.

  Lemma split_lower_same
        loc
        mem0 ts11 ts12 ts13 msg12 msg13
        mem1 from2 msg2 msg2'
        mem2
        (SPLIT1: Memory.split mem0 loc ts11 ts12 ts13 msg12 msg13 mem1)
        (LOWER2: Memory.lower mem1 loc from2 ts13 msg2 msg2' mem2):
    from2 = ts12 /\ msg13 = msg2 /\
    exists mem1',
      <<LOWER1: Memory.lower mem0 loc ts11 ts13 msg2 msg2' mem1'>> /\
      <<SPLIT2: Memory.split mem1' loc ts11 ts12 ts13 msg12 msg2' mem2>>.
  Proof.
    exploit Memory.lower_get0; eauto. erewrite Memory.split_o; eauto. repeat condtac; ss; cycle 2.
    { clear -o0. des; congr. }
    { des. subst. inv SPLIT1. inv SPLIT. exfalso. eapply Time.lt_strorder. eauto. }
    clear o a COND COND0. i. des. inv GET. splits; ss.
    exploit Memory.split_get0; eauto. i. des.
    exploit (@Memory.lower_exists mem0 loc ts11 ts13);
      try by inv LOWER2; inv LOWER; eauto.
    { inv SPLIT1. inv SPLIT. etrans; eauto. }
    i. des.
    exploit (@Memory.split_exists mem3 loc ts11 from2 ts13);
      try by inv SPLIT1; inv SPLIT; eauto.
    { erewrite Memory.lower_o; eauto. condtac; ss. des; congr. }
    i. des.
    cut (mem4 = mem2); [by i; subst; esplits; eauto|].
    apply Memory.ext. i.
    erewrite Memory.split_o; eauto. erewrite Memory.lower_o; eauto.
    erewrite (@Memory.lower_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
    repeat (condtac; ss).
    des. repeat subst. congr.
  Qed.

  Lemma split_remove
        mem0 loc1 ts11 ts12 ts13 msg12 msg13
        mem1 loc2 from2 to2 msg2
        mem2
        (LOCTS1: (loc1, ts12) <> (loc2, to2))
        (LOCTS2: (loc1, ts13) <> (loc2, to2))
        (SPLIT1: Memory.split mem0 loc1 ts11 ts12 ts13 msg12 msg13 mem1)
        (REMOVE2: Memory.remove mem1 loc2 from2 to2 msg2 mem2):
    exists mem1',
      <<REMOVE1: Memory.remove mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<SPLIT2: Memory.split mem1' loc1 ts11 ts12 ts13 msg12 msg13 mem2>>.
  Proof.
    exploit (@Memory.remove_exists mem0 loc2 from2 to2).
    { hexploit Memory.remove_get0; eauto.
      erewrite Memory.split_o; eauto. repeat condtac; ss.
      { des. subst. congr. }
      { guardH o. des. subst. congr. }
      guardH o. guardH o0. i. des. eauto.
    }
    i. des.
    exploit (@Memory.split_exists mem3 loc1 ts11 ts12 ts13);
      try by inv SPLIT1; inv SPLIT; eauto.
    { erewrite Memory.remove_o; eauto. condtac; ss.
      { des. subst. congr. }
      guardH o. hexploit Memory.split_get0; eauto. i. des. eauto.
    }
    i. des.
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.split_o; eauto. erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
    repeat (condtac; ss).
    - des. repeat subst. congr.
    - guardH o. des. repeat subst. congr.
  Qed.

  Lemma split_remove_same
        mem0 loc1 ts11 ts12 ts13 msg12 msg13
        mem1 from2 msg2
        mem2
        (SPLIT1: Memory.split mem0 loc1 ts11 ts12 ts13 msg12 msg13 mem1)
        (REMOVE2: Memory.remove mem1 loc1 from2 ts13 msg2 mem2):
    from2 = ts12 /\ msg13 = msg2 /\
    exists mem1',
      <<REMOVE1: Memory.remove mem0 loc1 ts11 ts13 msg13 mem1'>> /\
      <<ADD2: Memory.add mem1' loc1 ts11 ts12 msg12 mem2>>.
  Proof.
    exploit Memory.split_get0; eauto. i. des.
    exploit Memory.remove_get0; eauto. i. des.
    rewrite GET3 in *. inv GET2. splits; auto.
    exploit (@Memory.remove_exists mem0 loc1 ts11 ts13 msg13); eauto. i. des.
    exploit (@Memory.add_exists mem3 loc1 ts11 ts12 msg12); eauto.
    { ii. revert GET2.
      erewrite Memory.remove_o; eauto. condtac; ss. i. des; ss.
      exploit Memory.get_disjoint; [exact GET0|exact GET2|..]. i. des.
      { subst. ss. }
      inv LHS. inv RHS. ss.
      apply (x2 x); econs; ss.
      inv SPLIT1. inv SPLIT.
      etrans; try exact TO. econs; ss. }
    { inv SPLIT1. inv SPLIT. ss. }
    { inv SPLIT1. inv SPLIT. ss. }
    i. des. esplits; eauto.
    cut (mem4 = mem2); [i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.add_o; eauto. erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o mem2); eauto. erewrite (@Memory.split_o mem1); eauto.
    repeat (condtac; ss).
    des. subst. congr.
  Qed.

  Lemma lower_add
        mem0 loc1 from1 to1 msg1 msg1'
        mem1 loc2 from2 to2 msg2
        mem2
        (LOWER1: Memory.lower mem0 loc1 from1 to1 msg1 msg1' mem1)
        (ADD2: Memory.add mem1 loc2 from2 to2 msg2 mem2):
    exists mem1',
      <<ADD1: Memory.add mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<LOWER2: Memory.lower mem1' loc1 from1 to1 msg1 msg1' mem2>> /\
      <<LOCTS: (loc1, to1) <> (loc2, to2)>>.
  Proof.
    exploit (@Memory.add_exists mem0 loc2 from2 to2);
      try by inv ADD2; inv ADD; eauto.
    { apply covered_disjoint_get_disjoint. i. rewrite <- lower_covered in H; eauto.
      eapply get_disjoint_covered_disjoint; eauto. inv ADD2. inv ADD. auto.
    }
    i. des.
    exploit (@Memory.lower_exists mem3 loc1 from1 to1);
      try by inv LOWER1; inv LOWER; eauto.
    { erewrite Memory.add_o; eauto. condtac; ss.
      - des. subst. hexploit Memory.lower_get0; eauto. i. des.
        hexploit Memory.add_get0; eauto. i. des. congr.
      - guardH o. hexploit Memory.lower_get0; eauto. i. des. eauto.
    }
    i. des.
    esplits; eauto; cycle 1.
    { ii. inv H.
      exploit Memory.lower_get0; try exact LOWER1; eauto. i. des.
      exploit Memory.add_get0; eauto. i. des. congr.
    }
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.lower_o; eauto. erewrite Memory.add_o; eauto.
    erewrite (@Memory.add_o mem2); eauto. erewrite (@Memory.lower_o mem1); eauto.
    repeat (condtac; ss). des. repeat subst.
    exploit Memory.add_get0; try exact ADD2; eauto. i. des.
    revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
  Qed.

  Lemma lower_split
        mem0 loc1 from1 to1 msg1 msg1'
        mem1 loc2 ts21 ts22 ts23 msg22 msg23
        mem2
        (LOWER1: Memory.lower mem0 loc1 from1 to1 msg1 msg1' mem1)
        (SPLIT2: Memory.split mem1 loc2 ts21 ts22 ts23 msg22 msg23 mem2):
    exists from1' msg23' mem1',
      <<SPLIT1: Memory.split mem0 loc2 ts21 ts22 ts23 msg22 msg23' mem1'>> /\
      <<LOWER2: Memory.lower mem1' loc1 from1' to1 msg1 msg1' mem2>> /\
      <<FROM1: __guard__ ((loc1, to1, from1', msg1', msg23') = (loc2, ts23, ts22, msg23, msg1) \/
                          ((loc1, to1) <> (loc2, ts23) /\ (from1', msg23') = (from1, msg23)))>>.
  Proof.
    destruct (loc_ts_eq_dec (loc1, to1) (loc2, ts23)); ss.
    - des. subst.
      exploit Memory.split_get0; eauto. i. des.
      revert GET0. erewrite Memory.lower_o; eauto. condtac; ss; cycle 1.
      { des; congr. }
      i. inv GET0.
      exploit (@Memory.split_exists mem0 loc2 ts21 ts22 ts23);
        try by inv SPLIT2; inv SPLIT; eauto.
      { hexploit Memory.lower_get0; eauto. i. des. eauto. }
      i. des.
      exploit (@Memory.lower_exists mem3 loc2 ts22 ts23);
        try by inv LOWER1; inv LOWER; eauto.
      { erewrite Memory.split_o; eauto. repeat condtac; ss.
        ss. des. subst. inv SPLIT2. inv SPLIT.
        exfalso. eapply Time.lt_strorder. eauto.
      }
      { inv SPLIT2. inv SPLIT. auto. }
      i. des.
      esplits; eauto; cycle 1.
      { left. eauto. }
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.lower_o; eauto. erewrite Memory.split_o; eauto.
      erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.lower_o mem1); eauto.
      repeat (condtac; ss).
      des. repeat subst.
      revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
    - guardH o.
      exploit Memory.split_get0; eauto. i. des.
      exploit (@Memory.split_exists mem0 loc2 ts21 ts22 ts23);
        try by inv SPLIT2; inv SPLIT; eauto.
      { revert GET0. erewrite Memory.lower_o; eauto. condtac; eauto.
        ss. i. des. inv GET0. unguardH o. des; congr.
      }
      i. des.
      exploit (@Memory.lower_exists mem3 loc1 from1 to1);
        try by inv LOWER1; inv LOWER; eauto.
      { erewrite Memory.split_o; eauto. repeat condtac; ss.
        - des. subst. hexploit Memory.split_get0; eauto.
          hexploit Memory.lower_get0; eauto. i. des. congr.
        - guardH o0. des. subst.
          unguardH o. des; congr.
        - guardH o0. guardH o1. hexploit Memory.lower_get0; eauto. i. des. eauto.
      }
      i. des.
      esplits; eauto; cycle 1.
      { right. splits; eauto. ii. inv H. unguardH o. des; congr. }
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.lower_o; eauto. erewrite Memory.split_o; eauto.
      erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.lower_o mem1); eauto.
      repeat (condtac; ss).
      + des. repeat subst.
        revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
      + guardH o0. des. repeat subst. unguardH o. des; congr.
  Qed.

  Lemma lower_lower
        mem0 loc1 from1 to1 msg1 msg1'
        mem1 loc2 from2 to2 msg2 msg2'
        mem2
        (LOWER1: Memory.lower mem0 loc1 from1 to1 msg1 msg1' mem1)
        (LOWER2: Memory.lower mem1 loc2 from2 to2 msg2 msg2' mem2):
    (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ msg1' = msg2 /\
     Memory.lower mem0 loc1 from1 to1 msg1 msg2' mem2) \/
    (<<LOCTS1: (loc1, to1) <> (loc2, to2)>> /\
     exists mem1',
       <<LOWER1: Memory.lower mem0 loc2 from2 to2 msg2 msg2' mem1'>> /\
       <<LOWER2: Memory.lower mem1' loc1 from1 to1 msg1 msg1' mem2>>).
  Proof.
    exploit Memory.lower_get0; eauto. i. des.
    revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
    - des. subst. i. inv GET. left. splits; eauto.
      inv LOWER1. inv LOWER. inv LOWER2. inv LOWER.
      rewrite LocFun.add_add_eq. econs; auto.
      unfold Cell.lower in *.
      destruct r, r0. ss. subst.
      unfold LocFun.add. condtac; [|congr]. s.
      rewrite DOMap.add_add_eq. econs; auto.
      etrans; eauto.
    - guardH o. i. right. splits.
      { ii. inv H. unguardH o. des; congr. }
      exploit (@Memory.lower_exists mem0 loc2 from2 to2);
        try by inv LOWER2; inv LOWER; eauto.
      i. des.
      exploit (@Memory.lower_exists mem3 loc1 from1 to1);
        try by inv LOWER1; inv LOWER; eauto.
      { erewrite Memory.lower_o; eauto. condtac; ss.
        - des. subst. unguardH o. des; congr.
        - guardH o0. hexploit Memory.lower_get0; try exact LOWER1; eauto. i. des. eauto.
      }
      i. des.
      esplits; eauto.
      cut (mem4 = mem2); [by i; subst; eauto|].
      apply Memory.ext. i.
      erewrite Memory.lower_o; eauto. erewrite Memory.lower_o; eauto.
      erewrite (@Memory.lower_o mem2); eauto. erewrite (@Memory.lower_o mem1); eauto.
      repeat (condtac; ss). des. repeat subst.
      unguardH o. des; congr.
  Qed.

  Lemma lower_remove
        mem0 loc1 from1 to1 msg1 msg1'
        mem1 loc2 from2 to2 msg2
        mem2
        (LOCTS1: (loc1, to1) <> (loc2, to2))
        (LOWER1: Memory.lower mem0 loc1 from1 to1 msg1 msg1' mem1)
        (REMOVE2: Memory.remove mem1 loc2 from2 to2 msg2 mem2):
    exists mem1',
      <<REMOVE1: Memory.remove mem0 loc2 from2 to2 msg2 mem1'>> /\
      <<LOWER2: Memory.lower mem1' loc1 from1 to1 msg1 msg1' mem2>>.
  Proof.
    exploit (@Memory.remove_exists mem0 loc2 from2 to2).
    { hexploit Memory.remove_get0; eauto. i. des.
      revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
      { des. subst. congr. }
      eauto.
    }
    i. des.
    exploit (@Memory.lower_exists mem3 loc1 from1 to1);
      try by inv LOWER1; inv LOWER; eauto.
    { erewrite Memory.remove_o; eauto. condtac; ss.
      { des. subst. congr. }
      inv LOWER1. inv LOWER. eauto.
    }
    i. des.
    cut (mem4 = mem2); [by i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.lower_o; eauto. erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o mem2); eauto. erewrite (@Memory.lower_o mem1); eauto.
    repeat (condtac; ss). des. repeat subst. congr.
  Qed.

  Lemma lower_remove_same
        mem0 loc1 from1 to1 msg1 msg1'
        mem1 from2 msg2
        mem2
        (LOWER1: Memory.lower mem0 loc1 from1 to1 msg1 msg1' mem1)
        (REMOVE2: Memory.remove mem1 loc1 from2 to1 msg2 mem2):
    from1 = from2 /\ msg1' = msg2 /\
    <<REMOVE1: Memory.remove mem0 loc1 from1 to1 msg1 mem2>>.
  Proof.
    exploit Memory.lower_get0; eauto. i. des.
    exploit Memory.remove_get0; eauto. i. des.
    rewrite GET1 in *. inv GET0. splits; auto.
    exploit (@Memory.remove_exists mem0 loc1 from1 to1 msg1); eauto. i. des.
    cut (mem3 = mem2); [i; subst; eauto|].
    apply Memory.ext. i.
    erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o mem2); try exact REMOVE2.
    erewrite (@Memory.lower_o mem1); eauto.
    repeat (condtac; ss).
  Qed.

  Lemma remove_add
        mem0 loc1 from1 to1 msg1
        mem1 loc2 from2 to2 msg2
        mem2
        mem1'
        (REMOVE1: Memory.remove mem0 loc1 from1 to1 msg1 mem1)
        (ADD2: Memory.add mem1 loc2 from2 to2 msg2 mem2)
        (ADD1: Memory.add mem0 loc2 from2 to2 msg2 mem1'):
    Memory.remove mem1' loc1 from1 to1 msg1 mem2.
  Proof.
    exploit Memory.remove_get0; try eexact REMOVE1; eauto. i. des.
    exploit (@Memory.remove_exists mem1' loc1 from1 to1 msg1); eauto.
    { erewrite Memory.add_o; eauto. condtac; ss; eauto.
      des. subst. exploit Memory.add_get0; eauto. i. des. congr.
    }
    i. des.
    cut (mem3 = mem2); [by i; subst|].
    apply Memory.ext. i.
    erewrite Memory.remove_o; eauto. erewrite Memory.add_o; eauto.
    erewrite (@Memory.add_o mem2); eauto. erewrite (@Memory.remove_o mem1); eauto.
    repeat (condtac; ss). des. subst. subst.
    exploit Memory.add_get0; try eexact ADD1; eauto. i. des. congr.
  Qed.

  Lemma remove_split
        mem0 loc1 from1 to1 msg1
        mem1 loc2 ts21 ts22 ts23 msg22 msg23
        mem2
        mem1'
        (REMOVE1: Memory.remove mem0 loc1 from1 to1 msg1 mem1)
        (SPLIT2: Memory.split mem1 loc2 ts21 ts22 ts23 msg22 msg23 mem2)
        (SPLIT1: Memory.split mem0 loc2 ts21 ts22 ts23 msg22 msg23 mem1'):
    Memory.remove mem1' loc1 from1 to1 msg1 mem2.
  Proof.
    exploit Memory.remove_get0; try eexact REMOVE1; eauto. i. des.
    exploit Memory.split_get0; try exact SPLIT1; eauto. i. des.
    exploit (@Memory.remove_exists mem1' loc1 from1 to1 msg1); eauto.
    { erewrite Memory.split_o; eauto. repeat condtac; ss.
      - des. subst. congr.
      - guardH o. des. subst. rewrite GET0 in GET0. inv GET0.
        exploit Memory.split_get0; try exact SPLIT2; eauto. i. des.
        revert GET5. erewrite Memory.remove_o; eauto. condtac; ss.
    }
    i. des.
    cut (mem3 = mem2); [by i; subst|].
    apply Memory.ext. i.
    erewrite Memory.remove_o; eauto. erewrite Memory.split_o; eauto.
    erewrite (@Memory.split_o mem2); eauto. erewrite (@Memory.remove_o mem1); eauto.
    repeat (condtac; ss).
    - des; congr.
    - guardH o. des. subst. rewrite GET in GET2. inv GET2.
      exploit Memory.remove_get0; try exact GET1; eauto. i. des.
      revert GET2. erewrite Memory.split_o; eauto. repeat condtac; ss. i. inv GET2.
      inv SPLIT1. inv SPLIT. exfalso. eapply Time.lt_strorder. eauto.
  Qed.

  Lemma remove_lower
        mem0 loc1 from1 to1 msg1
        mem1 loc2 from2 to2 msg2' msg2
        mem2
        mem1'
        (REMOVE1: Memory.remove mem0 loc1 from1 to1 msg1 mem1)
        (LOWER2: Memory.lower mem1 loc2 from2 to2 msg2' msg2 mem2)
        (LOWER1: Memory.lower mem0 loc2 from2 to2 msg2' msg2 mem1'):
    Memory.remove mem1' loc1 from1 to1 msg1 mem2.
  Proof.
    exploit Memory.remove_get0; try eexact REMOVE1; eauto. i. des.
    exploit (@Memory.remove_exists mem1' loc1 from1 to1 msg1); eauto.
    { erewrite Memory.lower_o; eauto. condtac; ss.
      des. subst.
      exploit Memory.lower_get0; try exact LOWER2; eauto. i. des.
      revert GET1. erewrite Memory.remove_o; eauto. condtac; ss.
    }
    i. des.
    cut (mem3 = mem2); [by i; subst|].
    apply Memory.ext. i.
    erewrite Memory.remove_o; eauto. erewrite Memory.lower_o; eauto.
    erewrite (@Memory.lower_o mem2); eauto. erewrite (@Memory.remove_o mem1); eauto.
    repeat (condtac; ss). des. repeat subst.
    exploit Memory.lower_get0; try exact LOWER2; eauto. i. des.
    revert GET1. erewrite Memory.remove_o; eauto. condtac; ss.
  Qed.

  Lemma remove_remove
        promises0 loc1 from1 to1 msg1
        promises1 loc2 from2 to2 msg2
        promises2
        (REMOVE1: Memory.remove promises0 loc1 from1 to1 msg1 promises1)
        (REMOVE2: Memory.remove promises1 loc2 from2 to2 msg2 promises2):
    exists promises1',
      <<REMOVE1: Memory.remove promises0 loc2 from2 to2 msg2 promises1'>> /\
      <<REMOVE2: Memory.remove promises1' loc1 from1 to1 msg1 promises2>>.
  Proof.
    exploit Memory.remove_get0; try apply REMOVE2; eauto. i. des.
    revert GET. erewrite Memory.remove_o; eauto. condtac; ss. guardH o. i.
    exploit Memory.remove_exists; eauto. i. des.
    hexploit Memory.remove_get0; try apply REMOVE1; eauto. i. des.
    exploit (@Memory.remove_exists mem2 loc1 from1 to1 msg1); eauto.
    { erewrite Memory.remove_o; eauto. condtac; ss. des. subst. congr. }
    i. des.
    esplits; eauto.
    cut (mem0 = promises2); [by i; subst|].
    apply Memory.ext. i.
    erewrite Memory.remove_o; eauto. erewrite Memory.remove_o; eauto.
    erewrite (@Memory.remove_o promises2); eauto. erewrite (@Memory.remove_o promises1); eauto.
    repeat (condtac; ss).
  Qed.

  (* Lemmas on promise *)

  Lemma promise_add_remove
        loc1 from1 to1 msg1
        loc2 from2 to2 msg2
        promises0 mem0
        promises1 mem1
        promises2
        (LOCTS1: (loc1, to1) <> (loc2, to2))
        (PROMISE1: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 Memory.op_kind_add)
        (REMOVE2: Memory.remove promises1 loc2 from2 to2 msg2 promises2):
    exists promises1',
      <<REMOVE1: Memory.remove promises0 loc2 from2 to2 msg2 promises1'>> /\
      <<PROMISE2: Memory.promise promises1' mem0 loc1 from1 to1 msg1 promises2 mem1 Memory.op_kind_add>>.
  Proof.
    inv PROMISE1.
    exploit add_remove; try exact PROMISES; eauto. i. des.
    esplits; eauto.
  Qed.

  Lemma promise_split_remove
        loc1 from1 to1 msg1
        loc2 from2 to2 msg2
        to3 msg3
        promises0 mem0
        promises1 mem1
        promises2
        (LOCTS1: (loc1, to1) <> (loc2, to2))
        (LOCTS2: (loc1, to3) <> (loc2, to2))
        (PROMISE1: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 (Memory.op_kind_split to3 msg3))
        (REMOVE2: Memory.remove promises1 loc2 from2 to2 msg2 promises2):
    exists promises1',
      <<REMOVE1: Memory.remove promises0 loc2 from2 to2 msg2 promises1'>> /\
      <<PROMISE2: Memory.promise promises1' mem0 loc1 from1 to1 msg1 promises2 mem1 (Memory.op_kind_split to3 msg3)>>.
  Proof.
    inv PROMISE1.
    exploit split_remove; try exact PROMISES; eauto. i. des.
    esplits; eauto.
  Qed.

  Lemma promise_lower_remove
        loc1 from1 to1 msg0 msg1
        loc2 from2 to2 msg2
        promises0 mem0
        promises1 mem1
        promises2
        (LOCTS1: (loc1, to1) <> (loc2, to2))
        (PROMISE1: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 (Memory.op_kind_lower msg0))
        (REMOVE2: Memory.remove promises1 loc2 from2 to2 msg2 promises2):
    exists promises1',
      <<REMOVE1: Memory.remove promises0 loc2 from2 to2 msg2 promises1'>> /\
      <<PROMISE2: Memory.promise promises1' mem0 loc1 from1 to1 msg1 promises2 mem1 (Memory.op_kind_lower msg0)>>.
  Proof.
    inv PROMISE1.
    exploit lower_remove; try exact PROMISES; eauto. i. des.
    esplits; eauto.
  Qed.

  Lemma remove_promise
        promises1 loc1 from1 to1 msg1
        promises2 loc2 from2 to2 msg2
        promises3
        mem1 mem3
        kind
        (LE: Memory.le promises1 mem1)
        (REMOVE: Memory.remove promises1 loc1 from1 to1 msg1 promises2)
        (PROMISE: Memory.promise promises2 mem1 loc2 from2 to2 msg2 promises3 mem3 kind):
    exists promises2',
      Memory.promise promises1 mem1 loc2 from2 to2 msg2 promises2' mem3 kind /\
      Memory.remove promises2' loc1 from1 to1 msg1 promises3.
  Proof.
    inv PROMISE.
    - exploit Memory.add_exists_le; eauto. i. des.
      exploit remove_add; eauto.
    - exploit Memory.split_get0; try eexact PROMISES; eauto. i. des.
      revert GET0. erewrite Memory.remove_o; eauto. condtac; ss. i. guardH o.
      exploit Memory.split_exists; try exact GET0; try by inv PROMISES; inv SPLIT; eauto. i. des.
      exploit remove_split; eauto.
    - exploit Memory.lower_get0; try eexact PROMISES; eauto. i. des.
      revert GET. erewrite Memory.remove_o; eauto. condtac; ss. i. guardH o.
      exploit Memory.lower_exists; try exact GET; try by inv PROMISES; inv LOWER; eauto. i. des.
      exploit remove_lower; eauto.
    - exploit remove_remove; try exact REMOVE; eauto. i. des. eauto.
  Qed.

  Lemma promise_add_promise_split_same
        promises0 mem0 loc ts1 ts2 ts3 msg2 msg3
        promises1 mem1
        promises2 mem2
        (ADD1: Memory.promise promises0 mem0 loc ts1 ts3 msg3 promises1 mem1 Memory.op_kind_add)
        (SPLIT2: Memory.promise promises1 mem1 loc ts1 ts2 msg2 promises2 mem2 (Memory.op_kind_split ts3 msg3)):
    exists promises1' mem1',
      <<ADD1: Memory.promise promises0 mem0 loc ts1 ts2 msg2 promises1' mem1' Memory.op_kind_add>> /\
      <<ADD2: Memory.promise promises1' mem1' loc ts2 ts3 msg3 promises2 mem2 Memory.op_kind_add>>.
  Proof.
    inv ADD1. inv SPLIT2.
    exploit add_split; try exact PROMISES; eauto. i. des; [|congr].
    exploit add_split; try exact MEM; eauto. i. des; [|congr].
    esplits.
    - econs; eauto.
      i. exploit Memory.add_get0; try exact MEM. i. des.
      exploit Memory.add_get1; try exact GET; try exact MEM. i.
      exploit Memory.get_ts; try exact GET1. i. des.
      { subst. inv ADD3. inv ADD. inv TO. }
      exploit Memory.get_ts; try exact x8. i. des.
      { subst. inv ADD0. inv ADD. inv TO. }
      exploit Memory.get_disjoint; [exact GET1|exact x8|..]. i. des.
      { subst. inv ADD0. inv ADD. timetac. }
      destruct (TimeFacts.le_lt_dec ts3 to').
      + apply (x11 ts3); econs; ss; try refl.
        inv ADD3. inv ADD. ss.
      + apply (x11 to'); econs; ss; try refl.
        { etrans; try exact x10. inv ADD0. inv ADD. ss. }
        { econs. ss. }
    - econs; eauto.
      i. revert GET.
      erewrite Memory.add_o; eauto. condtac; ss; eauto.
      i. des. subst. inv GET. inv MEM. inv ADD. timetac.
  Qed.

  Lemma promise_split_promise_split_same
        promises0 mem0 loc ts1 ts2 ts3 ts4 val2 released2 msg3 msg4
        promises1 mem1
        promises2 mem2
        (SPLIT1: Memory.promise promises0 mem0 loc ts1 ts3 msg3 promises1 mem1 (Memory.op_kind_split ts4 msg4))
        (SPLIT2: Memory.promise promises1 mem1 loc ts1 ts2 (Message.concrete val2 released2) promises2 mem2 (Memory.op_kind_split ts3 msg3)):
    exists promises1' mem1',
      <<SPLIT1: Memory.promise promises0 mem0 loc ts1 ts2 (Message.concrete val2 released2) promises1' mem1' (Memory.op_kind_split ts4 msg4)>> /\
      <<SPLIT2: Memory.promise promises1' mem1' loc ts2 ts3 msg3 promises2 mem2 (Memory.op_kind_split ts4 msg4)>>.
  Proof.
    assert (LOCTS: (loc, ts4) <> (loc, ts3)).
    { intro X. inv X. inv SPLIT1. inv MEM. inv SPLIT. timetac. }
    inv SPLIT1. inv SPLIT2.
    exploit split_split; try exact PROMISES; eauto. i. des; [|congr].
    exploit split_split; try exact MEM; eauto. i. des; [|congr].
    esplits.
    - econs; eauto; congr.
    - econs; eauto.
  Qed.

  Lemma promise_lower_promise_split_same
        promises0 mem0 loc ts1 ts2 ts3 msg0 val2 released2 msg3
        promises1 mem1
        promises2 mem2
        (LOWER1: Memory.promise promises0 mem0 loc ts1 ts3 msg3 promises1 mem1 (Memory.op_kind_lower msg0))
        (SPLIT2: Memory.promise promises1 mem1 loc ts1 ts2 (Message.concrete val2 released2) promises2 mem2 (Memory.op_kind_split ts3 msg3)):
    exists promises1' mem1',
      <<SPLIT1: Memory.promise promises0 mem0 loc ts1 ts2 (Message.concrete val2 released2) promises1' mem1' (Memory.op_kind_split ts3 msg0)>> /\
      <<LOWER2: Memory.promise promises1' mem1' loc ts2 ts3 msg3 promises2 mem2 (Memory.op_kind_lower msg0)>>.
  Proof.
    inv LOWER1. inv SPLIT2.
    exploit lower_split; try exact PROMISES; eauto. i. des.
    unguard. des; [|congr]. inv FROM1.
    exploit lower_split; try exact MEM; eauto. i. des.
    unguard. des; [|congr]. inv FROM1.
    esplits.
    - econs; eauto. inv MEM. inv LOWER. inv MSG_LE; ss.
    - econs; eauto.
  Qed.

  Lemma promise_cancel
        promises0 mem0
        promises1 mem1
        promises2 mem2
        loc1 from1 to1 msg1 kind1
        loc2 from2 to2 msg2
        (PROMISE1: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 kind1)
        (CANCEL2: Memory.promise promises1 mem1 loc2 from2 to2 msg2 promises2 mem2 Memory.op_kind_cancel):
    (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ msg1 = Message.reserve /\ msg2 = Message.reserve /\
     kind1 = Memory.op_kind_add /\ promises0 = promises2 /\ mem0 = mem2) \/
    exists promises1' mem1',
      (<<CANCEL1: Memory.promise promises0 mem0 loc2 from2 to2 msg2 promises1' mem1' Memory.op_kind_cancel>>) /\
      (<<PROMISE2: Memory.promise promises1' mem1' loc1 from1 to1 msg1 promises2 mem2 kind1>>).
  Proof.
    inv CANCEL2. inv PROMISE1; ss.
    - destruct (classic ((loc1, to1) = (loc2, to2))).
      + inv H.
        exploit add_remove_same; try exact PROMISES0; eauto. i. des. subst.
        exploit add_remove_same; try exact MEM0; eauto. i. des. subst.
        left. splits; auto.
      + exploit add_remove; try exact PROMISES0; eauto. i. des.
        exploit add_remove; try exact MEM0; eauto. i. des.
        right. esplits; eauto. econs; eauto.
        i. revert GET.
        erewrite Memory.remove_o; eauto. condtac; ss. eauto.
    - des. destruct (classic ((loc1, ts3) = (loc2, to2))).
      + clarify.
        exploit split_remove_same; try exact PROMISES0; eauto. i. des. subst.
        exploit split_remove_same; try exact MEM1; eauto. i. des. subst. ss.
      + destruct (classic ((loc1, to1) = (loc2, to2))).
        { des. inv H0.
          exploit Memory.split_get0; try exact MEM0. i. des.
          exploit Memory.remove_get0; try exact MEM. i. des. congr. }
        exploit split_remove; try exact PROMISES0; eauto. i. des.
        exploit split_remove; try exact MEM0; eauto. i. des.
        right. esplits; eauto.
    - des. subst.
      destruct (classic ((loc1, to1) = (loc2, to2))).
      + inv H.
        exploit lower_remove_same; try exact PROMISES0; eauto. i. des. subst.
        exploit lower_remove_same; try exact MEM1; eauto. i. des. subst.
        exploit Memory.lower_get0; try exact MEM0. i. des. inv MSG_LE. ss.
      + exploit lower_remove; try exact PROMISES0; eauto. i. des.
        exploit lower_remove; try exact MEM0; eauto. i. des.
        right. esplits; eauto.
    - exploit remove_remove; try apply PROMISES0; eauto. i. des.
      exploit remove_remove; try apply MEM0; eauto. i. des.
      right. esplits; eauto.
  Qed.

  Lemma write_cancel
        promises0 mem0
        promises1 mem1
        promises2 mem2
        loc1 from1 to1 msg1 kind1
        loc2 from2 to2 msg2
        (WRITE1: Memory.write promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 kind1)
        (CANCEL2: Memory.promise promises1 mem1 loc2 from2 to2 msg2 promises2 mem2 Memory.op_kind_cancel):
    exists promises1' mem1',
      (<<CANCEL1: Memory.promise promises0 mem0 loc2 from2 to2 msg2 promises1' mem1' Memory.op_kind_cancel>>) /\
      (<<WRITE2: Memory.write promises1' mem1' loc1 from1 to1 msg1 promises2 mem2 kind1>>).
  Proof.
    inv WRITE1. inv CANCEL2.
    exploit remove_remove; [exact REMOVE|exact PROMISES|]. i. des.
    exploit promise_cancel; try exact PROMISE; eauto. i. des.
    { subst.
      exploit Memory.remove_get0; try exact REMOVE1. i. des.
      exploit Memory.remove_get0; try exact REMOVE2. i. des. congr.
    }
    esplits; eauto.
  Qed.

  Lemma write_na_cancel
        promises0 mem0
        promises1 mem1
        promises2 mem2
        ts loc1 from1 to1 val1 msgs1 kinds1 kind1
        loc2 from2 to2 msg2
        (WRITE1: Memory.write_na ts promises0 mem0 loc1 from1 to1 val1 promises1 mem1 msgs1 kinds1 kind1)
        (CANCEL2: Memory.promise promises1 mem1 loc2 from2 to2 msg2 promises2 mem2 Memory.op_kind_cancel):
    exists promises1' mem1',
      (<<CANCEL1: Memory.promise promises0 mem0 loc2 from2 to2 msg2 promises1' mem1' Memory.op_kind_cancel>>) /\
      (<<WRITE2: Memory.write_na ts promises1' mem1' loc1 from1 to1 val1 promises2 mem2 msgs1 kinds1 kind1>>).
  Proof.
    induction WRITE1.
    { exploit write_cancel; eauto. i. des. esplits; eauto. }
    exploit IHWRITE1; eauto. i. des.
    exploit write_cancel; eauto. i. des. esplits; eauto.
  Qed.

  Lemma reserve_promise
        prom0 mem0
        prom1 mem1
        prom2 mem2
        loc1 from1 to1
        loc2 from2 to2 msg2 kind2
        (STEP1: Memory.promise prom0 mem0 loc1 from1 to1 Message.reserve prom1 mem1 Memory.op_kind_add)
        (STEP2: Memory.promise prom1 mem1 loc2 from2 to2 msg2 prom2 mem2 kind2):
    (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ msg2 = Message.reserve /\
     kind2 = Memory.op_kind_cancel /\ prom0 = prom2 /\ mem0 = mem2) \/
    (exists prom1' mem1',
        (<<STEP1: Memory.promise prom0 mem0 loc2 from2 to2 msg2 prom1' mem1' kind2>>) /\
        (<<STEP2: Memory.promise prom1' mem1' loc1 from1 to1 Message.reserve prom2 mem2 Memory.op_kind_add>>)).
  Proof.
    inv STEP1. inv STEP2; ss.
    - (* reserve/add *)
      exploit add_add; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      exploit add_add; try exact MEM; try exact MEM0; eauto. i. des.
      right. esplits.
      + econs; eauto; try congr.
        i. exploit Memory.add_get1; try exact MEM; eauto.
      + econs; eauto.
    - (* reserve/split *)
      exploit add_split; try exact PROMISES; try exact PROMISES0; eauto. i.
      des; clarify.
      exploit add_split; try exact MEM; try exact MEM0; eauto. i. des; [congr|].
      right. esplits.
      + econs 2; eauto.
      + econs; eauto.
    - (* reserve/lower *)
      des. subst.
      exploit add_lower; try exact PROMISES; try exact PROMISES0; eauto. i.
      des; subst.
      + left. inv PROMISES0. inv LOWER. inv MSG_LE. ss.
      + exploit add_lower; try exact MEM; try exact MEM0; eauto. i. des; [congr|].
        right. esplits.
        * econs; eauto.
        * econs; eauto.
    - (* reserve/cancel *)
      destruct (classic ((loc1, to1) = (loc2, to2))).
      + inv H.
        exploit add_remove_same; try exact PROMISES0; eauto. i. des. subst.
        exploit add_remove_same; try exact MEM0; eauto. i. des. subst.
        left. splits; auto.
      + exploit add_remove; try exact PROMISES0; eauto. i. des.
        exploit add_remove; try exact MEM0; eauto. i. des.
        right. esplits; eauto.
  Qed.

  Lemma reserve_write
        prom0 mem0
        prom1 mem1
        prom2 mem2
        loc1 from1 to1
        loc2 from2 to2 msg2 kind2
        (STEP1: Memory.promise prom0 mem0 loc1 from1 to1 Message.reserve prom1 mem1 Memory.op_kind_add)
        (STEP2: Memory.write prom1 mem1 loc2 from2 to2 msg2 prom2 mem2 kind2)
        (MSG: msg2 <> Message.reserve):
    exists prom1' mem1',
      (<<STEP1: Memory.write prom0 mem0 loc2 from2 to2 msg2 prom1' mem1' kind2>>) /\
      (<<STEP2: Memory.promise prom1' mem1' loc1 from1 to1 Message.reserve prom2 mem2 Memory.op_kind_add>>).
  Proof.
    inv STEP2.
    exploit reserve_promise; try eauto. i. des; ss.
    inv STEP2.
    exploit add_remove; try exact PROMISES; eauto.
    { ii. inv H.
      exploit Memory.add_get0; try exact PROMISES. i. des.
      exploit Memory.remove_get0; try exact REMOVE. i. des.
      rewrite GET0 in *. inv GET1. ss.
    }
    i. des. esplits; eauto.
  Qed.

  Lemma reserve_write_na
        prom0 mem0
        prom1 mem1
        prom2 mem2
        loc1 from1 to1
        ts loc2 from2 to2 val2 msgs2 kinds2 kind2
        (STEP1: Memory.promise prom0 mem0 loc1 from1 to1 Message.reserve prom1 mem1 Memory.op_kind_add)
        (STEP2: Memory.write_na ts prom1 mem1 loc2 from2 to2 val2 prom2 mem2 msgs2 kinds2 kind2):
    exists prom1' mem1',
      (<<STEP1: Memory.write_na ts prom0 mem0 loc2 from2 to2 val2 prom1' mem1' msgs2 kinds2 kind2>>) /\
      (<<STEP2: Memory.promise prom1' mem1' loc1 from1 to1 Message.reserve prom2 mem2 Memory.op_kind_add>>).
  Proof.
    revert prom0 mem0 STEP1. induction STEP2; i.
    { exploit reserve_write; eauto; ss. i. des. esplits; eauto. }
    exploit reserve_write; eauto.
    { unguard. des; subst; ss. }
    i. des.
    exploit IHSTEP2; eauto. i. des. esplits; eauto.
  Qed.
End MemoryReorder.


Require Import Common Lia List ListSupport HVector FMap.
Require Import Syntax Topology Semantics SemFacts StepM Invariant Serial.

Require Export RqRsTopo RqRsFacts.
Require Export RqRsInvMsg RqRsInvLock RqRsInvSep RqRsInvAtomic.
Require Export RqRsMsgPred RqRsUtil.

Set Implicit Arguments.

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

Definition AtomicMsgOutsInv `{DecValue} `{OStateIfc} (mp: MsgOutPred)
           (eouts: list (Id Msg)) (nst: State): Prop :=
  Forall (fun eout => mp eout nst.(st_oss) nst.(st_orqs) nst.(st_msgs)) eouts.

Definition AtomicInv `{DecValue} `{OStateIfc} (mp: MsgOutPred):
  list (Id Msg) (* inits *) ->
  State (* starting state *) ->
  History (* atomic history *) ->
  list (Id Msg) (* eouts *) ->
  State (* ending state *) -> Prop :=
  fun inits st1 hst eouts st2 =>
    AtomicMsgOutsInv mp eouts st2.

Ltac disc_AtomicInv :=
  repeat
    match goal with
    | [H: AtomicInv _ _ _ _ _ _ |- _] => red in H; dest
    end.

Close Scope list.
Close Scope hvec.
Close Scope fmap.


Require Import OrderedType OrderedTypeEx OrderedTypeAlt DecidableType DecidableTypeEx.
Require Import RelationClasses.
From bcv Require Import vmtype dvm ovm.
Require bcv.heritage.

Module Offensive_correcte (H:heritage.Herit).

  Module D:= D(H).
  Module O:= O(H).

  (** Calcul de la valeur offensive d'une valeur défensive: on enlève
  le tag de type,et on met zéro là où il n'y a pas de valeur, de toute
  façon si le bcv est correct et accepte une applet, ces valeurs
  n'apparaitront jamais. *)
  Definition d2o (v:DefVal.Val): OffVal.Val :=
    match v with
      | DefVal.Vint i => i
      | DefVal.Vref (_,i) => i
      | DefVal.Vrefnull => 0
      | DefVal.Error => 0
      | DefVal.NonInit => 0
    end.

  (* Ceci permet de faire rewrite à l'intérieur l'argument de (map d2o).
     TODO: faire de ceci un proper generique du moment que la fonction
     est proper avec objfields. *)
  Instance map_d2o_morph:
    Proper (D.obj_eq ==> O.obj_eq)
           (fun obj : D.Obj =>
              {| O.objclass := D.objclass obj;
                 O.objfields := Dico.map d2o (D.objfields obj) |}).
  Proof.
    red. red.
    intros.
    inversion H.
    constructor;simpl;auto.
    rewrite H0.
    reflexivity.
  Qed.

  (** * Les fonctions d'offensivisation: on applique d2o partout. *)

  Definition offensive_regs rgs: O.Registers := Dico.map d2o rgs.

  Definition offensive_stack st: O.Stack := List.map d2o st.

  Definition offensive_heap hp: O.Heap :=
    Dico.map (fun obj =>
                {| O.objclass:= obj.(D.objclass) ; O.objfields := Dico.map d2o (obj.(D.objfields)) |}) hp.

  Definition offensive_state (s:D.State) : O.State :=
    let fr :=
        {| O.mdef := s.(D.frame).(D.mdef);
           O.regs := offensive_regs (s.(D.frame).(D.regs));
           O.stack := offensive_stack (s.(D.frame).(D.stack));
           O.pc:=s.(D.frame).(D.pc) |} in
    {| O.frame := fr;
       O.framestack := nil;
       O.heap := offensive_heap s.(D.heap) |}.

  Definition offensive_opt_state (s:option D.State) : option O.State :=
    match s with
      | None => None
      | Some x => Some (offensive_state x)
    end.

  Lemma pc_ok: forall s,  (s.(D.frame)).(D.pc) = (O.frame (offensive_state s)).(O.pc).
    destruct s;simpl;reflexivity.
  Qed.

  Lemma mdef_ok: forall s, D.mdef(s.(D.frame)) = O.mdef(O.frame(offensive_state s)).
  Proof.
    destruct s;simpl;reflexivity.
  Qed.

  Definition d2o_opt := option_map d2o.

  Add Morphism offensive_regs with signature Dico.Equal ==> Dico.Equal as off_regs_m.
  Proof.
    intros rgs1 rgs2 H.
    unfold offensive_regs.
    apply Dicomore.map_m with (x:= d2o) (y:= d2o) in H.
    - assumption.
    - reflexivity.
  Qed.

  Lemma find_offensive_ok : forall rgs ridx,
                              Dico.find ridx (offensive_regs rgs)
                              = d2o_opt (Dico.find ridx rgs).
  Proof.
    intros rgs.
    induction rgs using  Dicomore.map_induction_bis;simpl;intros.
    - rewrite <- H.
      apply IHrgs1.
    - vm_compute.
      reflexivity.
    - unfold offensive_regs.
      rewrite Dicomore.map_o.
      reflexivity.
  Qed.
  Import D.

  Axiom maxkey_off_ok: forall hp, maxkey (offensive_heap hp) = (maxkey hp).

  Lemma new_ok:
    forall clid (hp:D.Heap) x y x' y' z,
      Some (x,y) = O.new clid (offensive_heap hp) ->
      Some (z,x',y') = D.new clid hp ->
      x = x' /\
      Dico.Equal y
                (Dico.map (fun obj : D.Obj =>
                            {| O.objclass  := D.objclass obj;
                               O.objfields := Dico.map d2o (D.objfields obj) |})
                          y').
Proof.
  Admitted.

Lemma eq_built : forall t:ClasseDef , Dico.Equal (Dico.map d2o (build_flds t)) (O.build_flds t).
Proof.
  intros.
  induction t using  Dicomore.map_induction_bis;simpl;intros.
  - assert (Dico.Equal (build_flds t1) (build_flds t2)). {
      unfold build_flds.
      setoid_rewrite H.
      reflexivity.
    }
   setoid_rewrite <- H0.
   assert (Dico.Equal (O.build_flds t1) (O.build_flds t2)). {
      unfold build_flds.
      setoid_rewrite H.
      reflexivity.
    }
   setoid_rewrite <- H1.
    assumption.
  - simpl. apply O.build_flds_empty.
  - unfold build_flds.
    unfold O.build_flds.
    destruct e;
      rewrite Dicomore.add_map;
      rewrite Dicomore.add_map;
      rewrite Dicomore.add_map;
    simpl;
    apply Dicomore.F.add_m;try reflexivity;assumption.

 Qed.

  (** Diagramme de commutation entre D et O.*)
  Lemma offensive_ok :
    forall (s s':D.State) (os os' os'':O.State),
      offensive_state s = os ->
      offensive_state s' = os' ->
      D.exec_step s = Some s' ->
      O.exec_step os = Some os'' ->
      O.state_eq os' os''.
  Proof.
    intros.
    unfold exec_step in H1.
    unfold O.exec_step in H2.
    subst.
    rewrite <- pc_ok in H2.
    rewrite <- mdef_ok in H2.
    destruct (FIND (pc (frame s)) (instrs (mdef (frame s)))) eqn:heq_instrpc; try now inversion H1.
    - destruct i eqn:heq_instr; try now inversion H1.
      + inversion H1.
        inversion H2.
        unfold offensive_state. simpl. reflexivity.

      + destruct (stack (frame s)) eqn:heq_add;try now inversion H1.
      destruct d eqn:heq_1;try now inversion H1.
      destruct l eqn:heq_2;try now inversion H1.
      destruct d0 eqn:heq_3;try now inversion H1.
      unfold offensive_state in H2. simpl in H2.  rewrite heq_add in H2. simpl in H2. subst.
      inversion H1.
      inversion H2. clear H1 H2.
      unfold offensive_state .
      simpl.
      reflexivity.

     + destruct_with_eqn (FIND ridx (regs (frame s))) ; try now inversion H1.
       destruct_with_eqn d ; try now inversion H1.
       unfold offensive_state in H2.
       simpl in H2.
      unfold offensive_regs in H2.
        Search Dico.map.
      rewrite Dicomore.map_o in H2. simpl.
      setoid_rewrite  Heqo in H2.
      simpl in H2.
      inversion H1.
      inversion H2. clear H1 H2.
      subst.
      reflexivity.
    + destruct_with_eqn (FIND ridx (regs (frame s))) ; try now inversion H1.
      destruct_with_eqn d ; try now inversion H1.
      destruct clrf.
      destruct (H.sub c cl) ; try now inversion H1.
      unfold offensive_state in H2.
      simpl in H2.
      unfold offensive_regs in H2.
      Search Dico.map.
      rewrite Dicomore.map_o in H2. simpl.
      setoid_rewrite  Heqo in H2.
      inversion H1.
      inversion H2.  clear H1 H2.
      subst.
      reflexivity.
   + destruct_with_eqn (stack (frame s)); try now inversion H1.
     destruct_with_eqn d; try now inversion H1.
     unfold offensive_state in H2.
      simpl in H2.
      setoid_rewrite  Heql in H2.
    inversion H1.
      inversion H2.  clear H1 H2. simpl.
    unfold offensive_regs. simpl.

    apply O.state_eq_C;try reflexivity.
    * simpl.
      apply O.frame_eq_C;try reflexivity.
      -- simpl. Search Dico.map.
          apply Dicomore.add_map.

  + destruct_with_eqn (stack (frame s)); try now inversion H1.
    destruct_with_eqn d; try now inversion H1.
    unfold offensive_state in H2. simpl in H2.
    setoid_rewrite Heql in H2.
    destruct clrf.
    destruct (H.sub c cl).
    * inversion H1.
      inversion H2. clear H1 H2.
      unfold offensive_regs. simpl.
      apply O.state_eq_C;try reflexivity.
      -- simpl. apply O.frame_eq_C;try reflexivity.
        ++ simpl. unfold offensive_regs.
           rewrite Dicomore.add_map.
           simpl. reflexivity.
    * inversion H1.
  + destruct_with_eqn (stack (frame s)); try now inversion H1.
    destruct_with_eqn d; try now inversion H1.
    destruct_with_eqn i0; try now inversion H1.
    *
     unfold offensive_state in H2. simpl in H2.
     setoid_rewrite Heql in H2. simpl in H2.
     inversion H1. inversion H2. clear H1 H2.
     unfold offensive_state. simpl. reflexivity.

    * unfold offensive_state in H2. simpl in H2.
      setoid_rewrite Heql in H2. simpl in H2.
      inversion H1. inversion H2. clear H1 H2.
      unfold offensive_state. simpl. reflexivity.
  + inversion H1. inversion H2. clear H1 H2.
     unfold offensive_state. simpl. reflexivity.
  + destruct_with_eqn (stack (frame s)); try now inversion H1.
    destruct_with_eqn d; try now inversion H1.
    destruct clrf.
    case_eq (H.sub c cl);
    intros; subst;
    rewrite H in H1; try now inversion H1.
    destruct_with_eqn (FIND h (heap s) ); try now inversion H1.
    destruct_with_eqn o; try now inversion H1.
    case_eq (H.sub objclass0 cl);
    intros; subst;
    rewrite H0 in H1; try now  inversion H1.
    destruct_with_eqn (FIND fldrf objfields0); try now inversion H1. subst.
    unfold offensive_state in H2. simpl in H2.
    setoid_rewrite Heql in H2. simpl in H2. subst.
    unfold offensive_heap in H2. simpl in H2.
    rewrite Dicomore.F.map_o in H2.
    rewrite Heqo in H2. simpl in H2.
    rewrite Dicomore.F.map_o in H2.
    unfold objfields in H2. inversion Heqo.
    setoid_rewrite Heqo0 in H2. simpl in H2.
    * inversion H1. inversion H2. clear H1 H2.
      unfold offensive_state; simpl.
      reflexivity.

  + destruct_with_eqn (stack (frame s)); try now inversion H1.
    destruct_with_eqn d; try now inversion H1.
    destruct_with_eqn clrf. destruct l; try now inversion H1.
    destruct_with_eqn (H.sub c cl); try now inversion H1.
    destruct_with_eqn (FIND cl H.allcl); try now inversion H1.
    destruct_with_eqn (FIND fldrf t); try now inversion H1.
    destruct_with_eqn (compat (v2t d0) v); try now inversion H1.
    destruct_with_eqn (FIND h (heap s)); try now inversion H1.
    destruct_with_eqn o.
    unfold offensive_state in H2. simpl in H2.
    setoid_rewrite Heql in H2. simpl in H2.
    unfold offensive_heap in H2.
    rewrite Dicomore.F.map_o in H2.
    rewrite Heqo1 in H2. simpl in H2.
    inversion H1. inversion H2. clear H1 H2.
    unfold offensive_state; simpl.
    unfold offensive_heap.
apply O.state_eq_C; try reflexivity. simpl.
constructor.
rewrite Dicomore.add_map_equiv; try eauto with typeclass_instances. simpl.
rewrite Dicomore.add_map_equiv; try eauto with typeclass_instances. simpl.
reflexivity.
  + unfold new in H1;simpl in H1.

    destruct_with_eqn (FIND clid allcl ); try now inversion H1.
    unfold offensive_state in H2.
    unfold O.new in H2. simpl in H2.
    rewrite Heqo in H2. simpl in H2. subst.
rewrite maxkey_off_ok in H2.
unfold offensive_heap in H2.

    simpl in H2.
unfold offensive_stack in H2.  simpl in H2.
 inversion H1. inversion H2. clear H1 H2.
   unfold offensive_state; simpl. unfold offensive_stack. subst.
simpl. apply O.state_eq_C; try reflexivity. simpl. unfold offensive_heap. simpl.
apply O.heap_eq_C. rewrite Dicomore.add_map_equiv; try eauto with typeclass_instances.
simpl.
rewrite eq_built. reflexivity.
  +
   inversion H1. inversion H2. rewrite H0. reflexivity.
Qed.

End Offensive_correcte.


Require Import Definitions Algebra.Monoid Expr Algebra.SetoidCat Algebra.SetoidCat.MaybeUtils Algebra.Monad.Maybe Tactics Algebra.SetoidCat.ListUtils Algebra.Functor Algebra.Applicative Algebra.Alternative Algebra.FoldableFunctor Algebra.SetoidCat.PairUtils Algebra.Monad Algebra.Lens.Lens Algebra.Lens.MaybeLens ListLens Utils SetoidUtils SQL Pointed Lista Matrixp GenUtils Algebra.Monoid.MaybeUtils Algebra.SetoidCat.NatUtils.
Require Import Coq.Structures.DecidableTypeEx List SetoidClass PeanoNat FMapWeakList Basics Coq.Arith.Compare_dec.

Existing Instance maybe_Monad.
Instance maybeFunctor : @Functor maybe (@maybeS) := monadFunctor.
Instance maybe_Applicative : @Applicative maybe (@maybeS) _ := monad_Applicative.
Existing Instance maybe_mappend_PointedFunction2.

Definition unionRows : listaS (maybeS rowS) ~> listaS (maybeS rowS) ~~> listaS (maybeS rowS) :=
  lista_zipWithS maybe_first_mappend.

Definition minS := injF2 min _.

Existing Instance sqlVal_Pointed.

Definition _unionTables (tab1 tab2 : matrixp sqlVal) : matrixp sqlVal :=
  matrixpConsS @ (unionRows @ (tableRowsGetter @ tab1) @ (tableRowsGetter @ tab2)).

Instance _unionTables_Proper : Proper (equiv ==> equiv ==> equiv) _unionTables.
Proof.
  autounfold. intros. unfold _unionTables. rewritesr.
Qed.

Definition unionTables := injF2 _unionTables _.

Definition unionDatabases : databaseS ~> databaseS ~~> databaseS :=
  list_zipWithS' @ unionTables.

Definition caseSqlVal {A} {AS : Setoid A} (nat1 : natS ~> AS) (addr1 : natS ~*~ natS ~> AS) (func1 : sqlFuncS ~> AS) (nil1 : A) (row1 : sqlValS ~> sqlValS ~~> AS) val1 : A :=
  match val1 with
    | vNat n => nat1 @ n
    | vAddr n => addr1 @ n
    | vFunc a => func1 @ a
    | vRow a b => row1 @ a @ b
    | vNil => nil1
  end
.

Instance caseSqlVal_Proper A AS : Proper (equiv ==> equiv ==> equiv ==> equiv ==> equiv ==> equiv ==> equiv) (@caseSqlVal A AS).
Proof.
  autounfold. intros. simpl in H4.  rewrite H4. induction y4.
  - simpl. rewritesr.
  - simpl. rewritesr.
  - auto.
  - simpl. rewritesr.
  - simpl. rewritesr.
Qed.

Definition caseSqlValS {A AS} := injF6 (@caseSqlVal A AS) _.

Definition extractAddrS : sqlValS ~> maybeS (natS ~*~ natS) :=
  caseSqlValS
    @ (constS _ @ None)
    @ (SomeS)
    @ (constS _ @ None)
    @ None
    @ (constS _ @ (constS _ @ None)).

Definition extractNatS : sqlValS ~> maybeS natS :=
  caseSqlValS
    @ (SomeS)
    @ (constS _ @ None)
    @ (constS _ @ None)    @ None
    @ (constS _ @ (constS _ @ None)).

Instance vNat_Proper : Proper (equiv ==> equiv) vNat.
Proof.
  solve_proper.
Qed.

Definition vNatS : natS ~> sqlValS := injF vNat _.

Instance vAddr_Proper : Proper (equiv ==> equiv) vAddr.
Proof.
  autounfold. intros. destruct x,y. simpl in *. f_equal. f_equal. tauto.  tauto.
Qed.

Definition vAddrS : sqlAddrS ~> sqlValS := injF vAddr _.

Lemma row_equiv_dec : forall (r1 r2 : row) ,  {r1 == r2} + {~r1 == r2}.
Proof.
  intros. apply lista_equiv_dec.  apply SQLValType.equiv_dec.
Defined.

Lemma maybe_row_equiv_dec : forall r1 r2 : maybe row, {r1 == r2} + {~r1 == r2}.
Proof.
  intros. apply maybe_equiv_dec. apply row_equiv_dec.
Defined.


From lrust.lang Require Import proofmode memcpy.
From lrust.typing Require Export type lft_contexts type_context cont_context.
From iris.prelude Require Import options.

Section typing.
  Context `{!typeGS Σ}.

  (** Function Body *)
  (* This is an iProp because it is also used by the function type. *)
  Definition typed_body (E : elctx) (L : llctx) (C : cctx) (T : tctx)
                        (e : expr) : iProp Σ :=
    (∀ tid (qmax : Qp), lft_ctx -∗ elctx_interp E -∗ na_own tid ⊤ -∗ llctx_interp qmax L -∗
               cctx_interp tid qmax C -∗ tctx_interp tid T -∗
               WP e {{ _, cont_postcondition }})%I.
  Global Arguments typed_body _ _ _ _ _%E.

  Global Instance typed_body_llctx_permut E :
    Proper ((≡ₚ) ==> eq ==> eq ==> eq ==> (⊢)) (typed_body E).
  Proof.
    intros L1 L2 HL C ? <- T ? <- e ? <-. rewrite /typed_body.
    by setoid_rewrite HL.
  Qed.

  Global Instance typed_body_elctx_permut :
    Proper ((≡ₚ) ==> eq ==> eq ==> eq ==> eq ==> (⊢)) typed_body.
  Proof.
    intros E1 E2 HE L ? <- C ? <- T ? <- e ? <-. rewrite /typed_body.
    by setoid_rewrite HE.
  Qed.

  Global Instance typed_body_mono E L:
    Proper (flip (cctx_incl E) ==> flip (tctx_incl E L) ==> eq ==> (⊢))
           (typed_body E L).
  Proof.
    intros C1 C2 HC T1 T2 HT e ? <-. iIntros "H".
    iIntros (tid qmax) "#LFT #HE Htl HL HC HT".
    iDestruct (llctx_interp_acc_noend with "HL") as "[HL HLclose]".
    iMod (HT with "LFT HE HL HT") as "(HL & HT)".
    iDestruct ("HLclose" with "HL") as "HL".
    iApply ("H" with "LFT HE Htl HL [HC] HT").
    by iApply (HC with "LFT HE HC").
  Qed.

  Lemma typed_body_tctx_incl E L T2 T1 C e :
    tctx_incl E L T1 T2 →
    (⊢ typed_body E L C T2 e) →
    ⊢ typed_body E L C T1 e.
  Proof.
    intros Hincl He2. iApply typed_body_mono; last done; done.
  Qed.

  Global Instance typed_body_mono_flip E L:
    Proper (cctx_incl E ==> tctx_incl E L ==> eq ==> flip (⊢))
           (typed_body E L).
  Proof. intros ?????????. by eapply typed_body_mono. Qed.

  (** Instruction *)
  Definition typed_instruction (E : elctx) (L : llctx)
             (T1 : tctx) (e : expr) (T2 : val → tctx) : iProp Σ :=
    (∀ tid qmax, lft_ctx -∗ elctx_interp E -∗ na_own tid ⊤ -∗
              llctx_interp qmax L -∗ tctx_interp tid T1 -∗
              WP e {{ v, na_own tid ⊤ ∗
                         llctx_interp qmax L ∗ tctx_interp tid (T2 v) }})%I.
  Global Arguments typed_instruction _ _ _ _%E _.

  (** Writing and Reading **)
  Definition typed_write_def (E : elctx) (L : llctx) (ty1 ty ty2 : type) : iProp Σ :=
    (□ ∀ v tid F qmax qL, ⌜↑lftN ∪ (↑lrustN) ⊆ F⌝ →
      lft_ctx -∗ elctx_interp E -∗ llctx_interp_noend qmax L qL -∗ ty1.(ty_own) tid [v] ={F}=∗
        ∃ (l : loc) vl, ⌜length vl = ty.(ty_size) ∧ v = #l⌝ ∗ l ↦∗ vl ∗
          (▷ l ↦∗: ty.(ty_own) tid ={F}=∗
            llctx_interp_noend qmax L qL ∗ ty2.(ty_own) tid [v]))%I.
  Definition typed_write_aux : seal (@typed_write_def). Proof. by eexists. Qed.
  Definition typed_write := typed_write_aux.(unseal).
  Definition typed_write_eq : @typed_write = @typed_write_def := typed_write_aux.(seal_eq).
  Global Arguments typed_write _ _ _%T _%T _%T.

  Global Instance typed_write_persistent (E : elctx) (L : llctx) (ty1 ty ty2 : type) :
    Persistent (typed_write E L ty1 ty ty2).
  Proof. rewrite typed_write_eq. apply _. Qed.

  (* Technically speaking, we could remvoe the vl quantifiaction here and use
     mapsto_pred instead (i.e., l ↦∗: ty.(ty_own) tid). However, that would
     make work for some of the provers way harder, since they'd have to show
     that nobody could possibly have changed the vl (because only half the
     fraction was given). So we go with the definition that is easier to prove. *)
  Definition typed_read_def (E : elctx) (L : llctx) (ty1 ty ty2 : type) : iProp Σ :=
    (□ ∀ v tid F qmax qL, ⌜↑lftN ∪ ↑lrustN ⊆ F⌝ →
      lft_ctx -∗ elctx_interp E -∗ na_own tid F -∗
      llctx_interp_noend qmax L qL -∗ ty1.(ty_own) tid [v] ={F}=∗
        ∃ (l : loc) vl q, ⌜v = #l⌝ ∗ l ↦∗{q} vl ∗ ▷ ty.(ty_own) tid vl ∗
              (l ↦∗{q} vl ={F}=∗ na_own tid F ∗
                              llctx_interp_noend qmax L qL ∗ ty2.(ty_own) tid [v]))%I.
  Definition typed_read_aux : seal (@typed_read_def). Proof. by eexists. Qed.
  Definition typed_read := typed_read_aux.(unseal).
  Definition typed_read_eq : @typed_read = @typed_read_def := typed_read_aux.(seal_eq).
  Global Arguments typed_read _ _ _%T _%T _%T.

  Global Instance typed_read_persistent (E : elctx) (L : llctx) (ty1 ty ty2 : type) :
    Persistent (typed_read E L ty1 ty ty2).
  Proof. rewrite typed_read_eq. apply _. Qed.
End typing.

Definition typed_instruction_ty `{!typeGS Σ} (E : elctx) (L : llctx) (T : tctx)
    (e : expr) (ty : type) : iProp Σ :=
  typed_instruction E L T e (λ v, [v ◁ ty]).
Global Arguments typed_instruction_ty {_ _} _ _ _ _%E _%T.

Definition typed_val `{!typeGS Σ} (v : val) (ty : type) : Prop :=
  ∀ E L, ⊢ typed_instruction_ty E L [] (of_val v) ty.
Global Arguments typed_val _ _ _%V _%T.

Section typing_rules.
  Context `{!typeGS Σ}.

  (* This lemma is helpful when switching from proving unsafe code in Iris
     back to proving it in the type system. *)
  Lemma type_type E L C T e :
    typed_body E L C T e -∗ typed_body E L C T e.
  Proof. done. Qed.

  (** This lemma can replace [κ1] by [κ2] and vice versa in positions that
  respect "semantic lifetime equivalence"; in particular, lifetimes of
  references can be adjusted this way.  However, it cannot replace lifetimes in
  other type constructors, as those might only respect *syntactic* lifetime
  equivalence. This lemma is *weaker* than what was in the original paper where
  lifetimes could be replaced everywhere; it had to be adjusted for GhostCell.
  See [typing.lib.diverging_static] for an example of how
  [type_equivalize_lft_static] without this restriction ciuld be used to subvert
  branding.

  This is technically not a proper typing rule since the type system has no way
  to express "subtyping wrt semantic lifetime inclusion".  However, there is no
  fundamental reason that we could not also reflect all these semantic facts on
  the syntactic side, it would just be very clunky (and note that in Coq we do
  not reflect this syntactic side anway). *)
  Lemma type_equivalize_lft E L C T1 T2 κ1 κ2 e :
    (∀ tid, lft_ctx -∗ κ1 ⊑ κ2 -∗ κ2 ⊑ κ1 -∗ tctx_interp tid T1 -∗ tctx_interp tid T2) →
    (⊢ typed_body E L C T2 e) →
    ⊢ typed_body E ((κ1 ⊑ₗ [κ2]) :: L) C T1 e.
  Proof.
    iIntros (Hswitch He tid qmax) "#LFT #HE Htl [Hκ HL] HC HT".
    iMod (lctx_equalize_lft_sem with "LFT Hκ") as "[Hκ1 Hκ2]".
    iApply (He with "LFT HE Htl HL HC [-]").
    iApply (Hswitch with "LFT Hκ1 Hκ2"). done.
  Qed.
  Lemma type_equivalize_lft_static E L C T1 T2 κ e :
    (∀ tid, lft_ctx -∗ static ⊑ κ -∗ tctx_interp tid T1 -∗ tctx_interp tid T2) →
    (⊢ typed_body E L C T2 e) →
    ⊢ typed_body E ((κ ⊑ₗ []) :: L) C T1 e.
  Proof.
    iIntros (Hswitch He tid qmax) "#LFT #HE Htl [Hκ HL] HC HT".
    iMod (lctx_equalize_lft_sem_static with "LFT Hκ") as "Hκ".
    iApply (He with "LFT HE Htl HL HC [-]").
    iApply (Hswitch with "LFT Hκ"). done.
  Qed.

  Lemma type_let' E L T1 T2 (T : tctx) C xb e e' :
    Closed (xb :b: []) e' →
    typed_instruction E L T1 e T2 -∗
    (∀ v : val, typed_body E L C (T2 v ++ T) (subst' xb v e')) -∗
    typed_body E L C (T1 ++ T) (let: xb := e in e').
  Proof.
    iIntros (Hc) "He He'". iIntros (tid qmax) "#LFT #HE Htl HL HC HT". rewrite tctx_interp_app.
    iDestruct "HT" as "[HT1 HT]". wp_bind e. iApply (wp_wand with "[He HL HT1 Htl]").
    { iApply ("He" with "LFT HE Htl HL HT1"). }
    iIntros (v) "/= (Htl & HL & HT2)". wp_let.
    iApply ("He'" with "LFT HE Htl HL HC [HT2 HT]").
    rewrite tctx_interp_app. by iFrame.
  Qed.

  (* We do not make the [typed_instruction] hypothesis part of the
     Iris hypotheses, because we want to preserve the order of the
     hypotheses. The is important, since proving [typed_instruction]
     will instantiate [T1] and [T2], and hence we know what to search
     for the following hypothesis. *)
  Lemma type_let E L T T' T1 T2 C xb e e' :
    Closed (xb :b: []) e' →
    (⊢ typed_instruction E L T1 e T2) →
    tctx_extract_ctx E L T1 T T' →
    (∀ v : val, typed_body E L C (T2 v ++ T') (subst' xb v e')) -∗
    typed_body E L C T (let: xb := e in e').
  Proof.
    unfold tctx_extract_ctx. iIntros (? He ->) "?". iApply type_let'; last done.
    iApply He.
  Qed.

  Lemma type_seq E L T T' T1 T2 C e e' :
    Closed [] e' →
    (⊢ typed_instruction E L T1 e (λ _, T2)) →
    tctx_extract_ctx E L T1 T T' →
    typed_body E L C (T2 ++ T') e' -∗
    typed_body E L C T (e ;; e').
  Proof. iIntros. iApply (type_let E L T T' T1 (λ _, T2)); auto. Qed.

  Lemma type_newlft {E L C T} κs e :
    Closed [] e →
    (∀ κ, typed_body E ((κ ⊑ₗ κs) :: L) C T e) -∗
    typed_body E L C T (Newlft ;; e).
  Proof.
    iIntros (Hc) "He". iIntros (tid qmax) "#LFT #HE Htl HL HC HT".
    iMod (lft_create with "LFT") as (Λ) "[Htk #Hinh]"; first done.
    set (κ' := lft_intersect_list κs). wp_seq.
    iApply ("He" $! (κ' ⊓ Λ) with "LFT HE Htl [HL Htk] HC HT").
    rewrite /llctx_interp /=. iFrame "HL".
    iExists Λ. iSplit; first done.
    destruct (decide (1 ≤ qmax)%Qp) as [_|Hlt%Qp_lt_nge].
    - by iFrame "#∗".
    - apply Qp_lt_sum in Hlt as [q' ->]. iDestruct "Htk" as "[$ Htk]".
      iIntros "Htk'". iApply "Hinh". iFrame.
  Qed.

  (* TODO: It should be possible to show this while taking only one step.
     Right now, we could take two. *)
  Lemma type_endlft E L C T1 T2 κ κs e :
    Closed [] e → UnblockTctx κ T1 T2 →
    typed_body E L C T2 e -∗ typed_body E ((κ ⊑ₗ κs) :: L) C T1 (Endlft ;; e).
  Proof.
    iIntros (Hc Hub) "He". iIntros (tid qmax) "#LFT #HE Htl [Hκ HL] HC HT".
    iDestruct "Hκ" as (Λ) "(% & Htok & Hend)".
    iSpecialize ("Hend" with "Htok"). wp_bind Endlft.
    iApply (wp_mask_mono _ (↑lftN ∪ lft_userE)); first done.
    iApply (wp_step_fupd with "Hend"); first set_solver+. wp_seq.
    iIntros "#Hdead !>". wp_seq. iApply ("He" with "LFT HE Htl HL HC [> -]").
    iApply (Hub with "[] HT"). simpl in *. subst κ. rewrite -lft_dead_or. auto.
  Qed.

  Lemma type_path_instr {E L} p ty :
    ⊢ typed_instruction_ty E L [p ◁ ty] p ty.
  Proof.
    iIntros (??) "_ _ $$ [? _]".
    iApply (wp_hasty with "[-]"); first done. iIntros (v) "_ Hv".
    rewrite tctx_interp_singleton. iExists v. iFrame. by rewrite eval_path_of_val.
  Qed.

  Lemma type_letpath {E L} ty C T T' x p e :
    Closed (x :b: []) e →
    tctx_extract_hasty E L p ty T T' →
    (∀ (v : val), typed_body E L C ((v ◁ ty) :: T') (subst' x v e)) -∗
    typed_body E L C T (let: x := p in e).
  Proof. iIntros. iApply type_let; [by apply type_path_instr|solve_typing|done]. Qed.

  Lemma type_assign_instr {E L} ty ty1 ty1' p1 p2 :
    (⊢ typed_write E L ty1 ty ty1') →
    (⊢ typed_instruction E L [p1 ◁ ty1; p2 ◁ ty] (p1 <- p2) (λ _, [p1 ◁ ty1'])).
  Proof.
    iIntros (Hwrt tid ?) "#LFT #HE $ HL".
    rewrite tctx_interp_cons tctx_interp_singleton. iIntros "[Hp1 Hp2]".
    wp_bind p1. iApply (wp_hasty with "Hp1"). iIntros (v1) "% Hown1".
    wp_bind p2. iApply (wp_hasty with "Hp2"). iIntros (v2) "_ Hown2".
    rewrite typed_write_eq in Hwrt.
    iDestruct (llctx_interp_acc_noend with "HL") as "[HL HLclose]".
    iMod (Hwrt with "[] LFT HE HL Hown1") as (l vl) "([% %] & Hl & Hclose)"; first done.
    subst v1. iDestruct (ty_size_eq with "Hown2") as "#Hsz". iDestruct "Hsz" as %Hsz.
    rewrite <-Hsz in *. destruct vl as [|v[|]]; try done.
    rewrite heap_mapsto_vec_singleton. iApply wp_fupd. wp_write.
    rewrite -heap_mapsto_vec_singleton.
    iMod ("Hclose" with "[Hl Hown2]") as "(HL & Hown)".
    { iExists _. iFrame. }
    iDestruct ("HLclose" with "HL") as "$".
    rewrite tctx_interp_singleton tctx_hasty_val' //.
  Qed.

  Lemma type_assign {E L} ty1 ty ty1' C T T' p1 p2 e:
    Closed [] e →
    tctx_extract_ctx E L [p1 ◁ ty1; p2 ◁ ty] T T' →
    (⊢ typed_write E L ty1 ty ty1') →
    typed_body E L C ((p1 ◁ ty1') :: T') e -∗
    typed_body E L C T (p1 <- p2 ;; e).
  Proof. iIntros. by iApply type_seq; first apply type_assign_instr. Qed.

  Lemma type_deref_instr {E L} ty ty1 ty1' p :
    ty.(ty_size) = 1%nat → (⊢ typed_read E L ty1 ty ty1') →
    (⊢ typed_instruction E L [p ◁ ty1] (!p) (λ v, [p ◁ ty1'; v ◁ ty])).
  Proof.
    iIntros (Hsz Hread tid qmax) "#LFT #HE Htl HL Hp".
    rewrite tctx_interp_singleton. wp_bind p. iApply (wp_hasty with "Hp").
    iIntros (v) "% Hown".
    rewrite typed_read_eq in Hread.
    iDestruct (llctx_interp_acc_noend with "HL") as "[HL HLclose]".
    iMod (Hread with "[] LFT HE Htl HL Hown") as
        (l vl q) "(% & Hl & Hown & Hclose)"; first done.
    subst v. iDestruct (ty_size_eq with "Hown") as "#>%". rewrite ->Hsz in *.
    destruct vl as [|v [|]]; try done.
    rewrite heap_mapsto_vec_singleton. iApply wp_fupd. wp_read.
    iMod ("Hclose" with "Hl") as "($ & HL & Hown2)".
    iDestruct ("HLclose" with "HL") as "$".
    rewrite tctx_interp_cons tctx_interp_singleton tctx_hasty_val tctx_hasty_val' //.
    by iFrame.
  Qed.

  Lemma type_deref {E L} ty1 C T T' ty ty1' x p e:
    Closed (x :b: []) e →
    tctx_extract_hasty E L p ty1 T T' →
    (⊢ typed_read E L ty1 ty ty1') →
    ty.(ty_size) = 1%nat →
    (∀ (v : val), typed_body E L C ((p ◁ ty1') :: (v ◁ ty) :: T') (subst' x v e)) -∗
    typed_body E L C T (let: x := !p in e).
  Proof. iIntros. by iApply type_let; [apply type_deref_instr|solve_typing|]. Qed.

  Lemma type_memcpy_iris E L qmax qL tid ty ty1 ty1' ty2 ty2' (n : Z) p1 p2 :
    Z.of_nat (ty.(ty_size)) = n →
    typed_write E L ty1 ty ty1' -∗ typed_read E L ty2 ty ty2' -∗
    {{{ lft_ctx ∗ elctx_interp E ∗ na_own tid ⊤ ∗ llctx_interp_noend qmax L qL ∗
        tctx_elt_interp tid (p1 ◁ ty1) ∗ tctx_elt_interp tid (p2 ◁ ty2) }}}
      (p1 <-{n} !p2)
    {{{ RET #☠; na_own tid ⊤ ∗ llctx_interp_noend qmax L qL ∗
                 tctx_elt_interp tid (p1 ◁ ty1') ∗ tctx_elt_interp tid (p2 ◁ ty2') }}}.
  Proof.
    iIntros (<-) "#Hwrt #Hread !>".
    iIntros (Φ) "(#LFT & #HE & Htl & [HL1 HL2] & [Hp1 Hp2]) HΦ".
    wp_bind p1. iApply (wp_hasty with "Hp1"). iIntros (v1) "% Hown1".
    wp_bind p2. iApply (wp_hasty with "Hp2"). iIntros (v2) "% Hown2".
    rewrite typed_write_eq typed_read_eq.
    iMod ("Hwrt" with "[] LFT HE HL1 Hown1")
      as (l1 vl1) "([% %] & Hl1 & Hcl1)"; first done.
    iMod ("Hread" with "[] LFT HE Htl HL2 Hown2")
      as (l2 vl2 q2) "(% & Hl2 & Hown2 & Hcl2)"; first done.
    iDestruct (ty_size_eq with "Hown2") as "#>%". subst v1 v2. iApply wp_fupd.
    iApply (wp_memcpy with "[$Hl1 $Hl2]"); try congruence; [].
    iNext. iIntros "[Hl1 Hl2]". iApply ("HΦ" with "[> -]"). rewrite !tctx_hasty_val' //.
    iMod ("Hcl1" with "[Hl1 Hown2]") as "($ & $)".
    { iExists _. iFrame. }
    iMod ("Hcl2" with "Hl2") as "($ & $ & $)". done.
  Qed.

  Lemma type_memcpy_instr {E L} ty ty1 ty1' ty2 ty2' (n : Z) p1 p2 :
    Z.of_nat (ty.(ty_size)) = n →
    (⊢ typed_write E L ty1 ty ty1') →
    (⊢ typed_read E L ty2 ty ty2') →
    ⊢ typed_instruction E L [p1 ◁ ty1; p2 ◁ ty2] (p1 <-{n} !p2)
                      (λ _, [p1 ◁ ty1'; p2 ◁ ty2']).
  Proof.
    iIntros (Hsz Hwrt Hread tid qmax) "#LFT #HE Htl HL HT".
    iDestruct (llctx_interp_acc_noend with "HL") as "[HL HLclose]".
    iApply (type_memcpy_iris with "[] [] [$LFT $Htl $HE $HL HT]"); try done.
    { by rewrite tctx_interp_cons tctx_interp_singleton. }
    rewrite tctx_interp_cons tctx_interp_singleton.
    iIntros "!> ($ & HL & $ & $)". by iApply "HLclose".
  Qed.

  Lemma type_memcpy {E L} ty ty1 ty2 (n : Z) C T T' ty1' ty2' p1 p2 e:
    Closed [] e →
    tctx_extract_ctx E L [p1 ◁ ty1; p2 ◁ ty2] T T' →
    (⊢ typed_write E L ty1 ty ty1') →
    (⊢ typed_read E L ty2 ty ty2') →
    Z.of_nat (ty.(ty_size)) = n →
    typed_body E L C ((p1 ◁ ty1') :: (p2 ◁ ty2') :: T') e -∗
    typed_body E L C T (p1 <-{n} !p2;; e).
  Proof. iIntros. by iApply type_seq; first eapply (type_memcpy_instr ty ty1 ty1'). Qed.
End typing_rules.