(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

Require Export Max.
Require Export Zpower.
Require Export Zlogarithm.
Require Export QArith.
Require Export Qpower.
Open Scope Z_scope.
Open Scope Q_scope.

Require Extraction.

Coercion inject_Z : Z >-> Q.
Local Coercion Z_of_nat : nat >-> Z.

Ltac QpowerSimpl :=
(repeat rewrite inj_S;
 unfold Zsucc;
 repeat rewrite Qpower_plus; try discriminate;
 simpl).

Ltac get_hd := match goal with |- ?H -> _ => H end.
Ltac get_gl := match goal with |- ?H => H end.

Ltac lhs H :=
 match H with
  | ?a <= _ => a
  | ?a < _ => a
  | ?a == _ => a
 end.

Ltac rhs H :=
 match H with
  | _ <= ?a => a
  | _ < ?a => a
  | _ == ?a => a
 end.

Ltac step_left t :=  let H := get_gl in let a := lhs H in setoid_replace a with t by (QpowerSimpl;ring).
Ltac step_right t :=  let H := get_gl in let a := rhs H in setoid_replace a with t by (QpowerSimpl;ring).
Ltac step_left_hd t :=  let H := get_hd in let a := lhs H in setoid_replace a with t by (QpowerSimpl;ring).
Ltac step_right_hd t := let H := get_hd in let a := rhs H in setoid_replace a with t by (QpowerSimpl;ring).
Ltac step t := let a := lhs t in step_left a; let b := rhs t in step_right b.
Ltac step_hd t := let a := lhs t in step_left_hd a; let b := rhs t in step_right_hd b.

Local Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope.

(**** A quick & dirty implementation of constructive reals. ****)
(****      Based on Pr. Schwichtenberg lecture notes.        ****)
(****      Main objective: sqrt(2) as root of X^2 -2  in [1;2]   ****)

(* First, the Cauchy property. *)

Definition Is_Cauchy (f : nat -> Q) (mo : nat -> nat) :=
  forall k m n,  (mo k <= m)%nat -> (mo k <= n)%nat ->
  -(1#2)^k <= f m - f n <= (1#2)^k.

(* A real is given by a cauchy sequence, a modulus sequence *)
(* and a proof of the Cauchy property of these sequences. *)

Record R : Set := {
  cauchy : nat -> Q;
  modulus : nat -> nat;
  is_cauchy : Is_Cauchy cauchy modulus }.

(* Recursive Extraction R. *)

(* A rational is injected into R via a constant cauchy sequence. *)

Definition inject_Q : Q -> R.
Proof.
intros q.
apply (Build_R (fun _ => q) (fun _ => O)).
red; intros.
assert (H1: q-q == 0) by ring.
rewrite H1; clear H1.
assert (0 <= (1#2)^k).
 apply Qpower_pos.
 compute; intro; discriminate.
split; auto.
replace 0 with (-0) by auto.
apply Qopp_le_compat; auto.
Defined.

(* Extraction inject_Q. *)

(* The non-computational equality upon R. *)

Definition Req : R -> R -> Prop:=
    fun x y : R =>
      forall k, let M := modulus x (S k) in
            let N := modulus y (S k) in
            -(1#2)^k <= cauchy x M - cauchy y N <= (1#2)^k.

(* The informative positivity upon R. *)

Definition Rpos_k : nat -> R -> Prop :=
  fun k x => (1#2)^k <= cauchy x (modulus x (S k)).

Definition Rpos : R -> Set := fun x => { k:nat | Rpos_k k x }.

(* The logical non-negativity upon R. *)

Definition Rnonneg : R -> Prop :=
 fun x => forall k:nat, -(1#2)^k <= cauchy x (modulus x k).

(* The Dirty Part: *)

(**** Beware! Use with caution! Not for kids! ****)
Axiom Falsum: False.
Ltac fedup := elim Falsum.
(*****************************************************)

Definition test : R -> R -> R.
fedup.
Qed.
(* Extraction test. *)

(* Addition on R. *)
(* Only the informative parts are provided.
    The logical statement is skipped. *)

(*
Lemma two_power_S : forall k, !2^(S k) = (2 *(!2^k))%Z.
intros.
rewrite <- two_power_nat_S; auto with zarith.
Qed.
*)

Lemma max_le : forall a b c, le (max a b) c -> le a c /\ le b c.
Proof.
eauto with arith.
Qed.

Lemma Qeq_Qle : forall a b:Q, a==b -> a<=b.
Proof.
intros. setoid_replace a with b by auto. apply Qle_refl.
Qed.

Definition Rplus : R -> R -> R.
Proof.
intros x y.
apply (Build_R (fun n => cauchy x n + cauchy y n)
                          (fun k => max (modulus x (S k)) (modulus y (S k)))).
unfold Is_Cauchy; intros.
set (N := modulus x (S k)) in *.
set (M := modulus y (S k)) in *.
elim (max_le N M m H); elim (max_le N M n H0); intros.
assert (H5 := is_cauchy x (S k) m n H3 H1).
assert (H6 := is_cauchy y (S k) m n H4 H2).
clear N M H H0 H1 H2 H3 H4.
set (Xn := cauchy x n) in *; set (Xm := cauchy x m) in *;
set (Yn := cauchy y n) in *; set (Ym := cauchy y m) in *.
destruct H5; destruct H6.
setoid_replace (Xm+Ym-(Xn+Yn)) with ((Xm-Xn) +(Ym-Yn)) by ring.
split.
step_left (-(1#2)^(S k)+-(1#2)^(S k)).
apply Qplus_le_compat; auto.
step_right ((1#2)^(S k)+(1#2)^(S k)).
apply Qplus_le_compat; auto.
Defined.

(* Extraction Rplus. *)

Definition Ropp : R -> R.
intros x.
apply (Build_R (fun n => -(cauchy x n)) (fun k => modulus x k)).
unfold Is_Cauchy; intros.
unfold Qminus.
rewrite (Qopp_opp (cauchy x n)).
rewrite (Qplus_comm (-(cauchy x m)) (cauchy x n)).
apply (is_cauchy x k n m); auto.
Defined.

Definition Rminus : R -> R -> R := fun x y => Rplus x (Ropp y).

Definition Rlt : R -> R -> Set := fun x y => Rpos (Rminus y x).

Definition Rle : R -> R -> Prop := fun x y => Rnonneg (Rminus y x).

(* An alternative characterization of positivity upon R. *)

Definition Rpos_alt (x:R) :=
 {l:nat & { p:nat | forall n, (p<=n)%nat -> (1#2)^l <= cauchy x n}}.

Lemma Rpos_alt_1 : forall x:R, Rpos x -> Rpos_alt x.
Proof.
unfold Rpos, Rpos_k, Rpos_alt.
intros.
elim H; intros k Hk; clear H.
exists (S k).
exists (modulus x (S k)).
intros.
(*fedup.*)
destruct (x.(is_cauchy) (S k) n (modulus x (S k))) as (Hx,_); auto.
generalize (Qplus_le_compat _ _ _ _ Hk Hx).
step_hd ((1#2)^(S k)<=cauchy x n); auto.
Defined.

Lemma Rpos_alt_2 : forall x, Rpos_alt x -> Rpos x.
unfold Rpos, Rpos_k, Rpos_alt.
intros.
elim H; intros l Hl; elim Hl; intros p Hp; clear H Hl.
exists (S l).
(*fedup.*)
set (M:=modulus x (S (S l))).
set (N:=max p M).
destruct (x.(is_cauchy) (S (S l)) M N) as (Hx,_); auto.
unfold N, M; auto with arith.
apply Qle_trans with ((1#2)^l+(-(1#2)^(S (S l)))).
step ((1#2)*(1#2)^l<=(3#4)*(1#2)^l).
apply Qmult_le_compat_r; [|apply Qpower_pos]; compute; intro; discriminate.
step_right (cauchy x N +(cauchy x M - cauchy x N)).
apply Qplus_le_compat; auto.
apply Hp; unfold N; auto with arith.
Defined.

(* The Key Lemma: comparison between three reals. *)

Definition Rcompare : forall x y, Rlt x y -> forall z, Rlt x z + Rlt z y.
unfold Rlt; intros.
destruct (Rpos_alt_1 _ H) as (k,(p,Hp)); clear H.
set (k' := S (S k)).
set (k'' := S (S k')).
set (q := max (modulus x k'') (max (modulus y k'') (max (modulus z k'') p))).
destruct (Qlt_le_dec (cauchy z q - cauchy x q)  ((1#2)^(S k)));
 [right|left]; exists k'.
(*fedup.*)
red; simpl cauchy; simpl cauchy in Hp.
set (q' := max (modulus y (S (S k'))) (modulus z (S (S k')))).
destruct (z.(is_cauchy) k'' q q') as (Hz,_); auto.
unfold q, k''; eauto with arith.
unfold q', k''; auto with arith.
destruct (y.(is_cauchy) k'' q' q) as (Hy,_); auto.
unfold q', k''; auto with arith.
unfold q, k''; eauto with arith.
assert (p <= q)%nat by (unfold q; eauto with arith).
assert (H0:=Hp q H); clear Hp H.
assert (H1:=Qopp_le_compat _ _ (Qlt_le_weak _ _ q0)); clear q0.
set (Yq' := cauchy y q') in *; set (Yq := cauchy y q) in *;
 set (Zq' := cauchy z q') in *; set (Zq := cauchy z q) in *;
 set (Xq := cauchy x q) in *; clearbody q q' Yq Yq' Zq Zq' Xq.
generalize (Qplus_le_compat _ _ _ _ Hy
                   (Qplus_le_compat _ _ _ _ H0
                       (Qplus_le_compat _ _ _ _ H1 Hz))).
unfold k'', k'.
step_hd ((3#8)*(1#2)^k <= Yq'+-Zq').
intros.
step_left ((1#4)*(1#2)^k).
apply Qle_trans with ((3#8)*(1#2)^k); auto.
apply Qmult_le_compat_r; [|apply Qpower_pos]; compute; intro; discriminate.
(*fedup.*)
red; simpl cauchy; simpl cauchy in Hp.
set (q' := max (modulus z (S (S k'))) (modulus x (S (S k')))).
destruct (z.(is_cauchy) k'' q' q) as (Hz,_); auto.
unfold q', k''; auto with arith.
unfold q, k''; eauto with arith.
destruct (x.(is_cauchy) k'' q q') as (Hx,_); auto.
unfold q, k''; eauto with arith.
unfold q', k''; auto with arith.
clear Hp.
set (Xq' := cauchy x q') in *; set (Xq := cauchy x q) in *;
 set (Zq' := cauchy z q') in *; set (Zq := cauchy z q) in *;
 clearbody q q' Xq Xq' Zq Zq'.
generalize (Qplus_le_compat _ _ _ _ Hz
                   (Qplus_le_compat _ _ _ _ q0 Hx)).
unfold k'', k'.
step_hd ((3#8)*(1#2)^k <= Zq'+-Xq').
intros.
step_left ((1#4)*(1#2)^k).
apply Qle_trans with ((3#8)*(1#2)^k); auto.
apply Qmult_le_compat_r; [|apply Qpower_pos]; compute; intro; discriminate.
Defined.

(* Specialized continuity components for sqr2 = X^2-2 *)

Definition sqr2 := fun a => (a * a)+(-2).
Definition sqr2_h := fun a (_:nat) => sqr2 a.
Definition sqr2_alpha := fun (_:nat) => O.
Definition sqr2_w := fun k => S (S (S k)).

(* Specialized application of sqr2 to a real. *)

Definition sqr2_apply : R -> R.
intros x.
apply (Build_R (fun n => sqr2_h (cauchy x n) n)
                       (fun k => max (sqr2_alpha (S (S k)))
                                        (modulus x (pred (sqr2_w (S k)))))).
generalize x.(is_cauchy).
unfold Is_Cauchy, sqr2_h, sqr2_alpha, sqr2_w, sqr2; simpl; intros.
(*fedup.*)
generalize (H _ _ _ H0 H1); clear H H0 H1; intro H.
destruct x; simpl.
unfold cauchy; simpl.
fedup.
Defined.

(* sqr2 is strictly increasing at least on interval [1;infinity] *)

Definition sqr2_incr : forall x y, Rle (inject_Q 1) x -> Rle (inject_Q 1) y ->
  Rlt x y -> Rlt (sqr2_apply x) (sqr2_apply y).
unfold Rlt; intros.
apply Rpos_alt_2.
generalize (Rpos_alt_1 _ H1); clear H1.
unfold Rpos_alt, Rminus, Ropp, Rplus; simpl; unfold sqr2_h; simpl.
intro H1; elim H1; intros k Hk; elim Hk; intros p Hp; clear H Hk.
exists (pred k).
exists p.
(*fedup*)
intros.
generalize (Hp _ H); clear Hp; intros.
unfold sqr2.
step_right ((cauchy y n +-cauchy x n)*(cauchy y n + cauchy x n)).
red in H0.
red in H0.
simpl in H0.
fedup.
Defined.

Lemma One_lt_Two : Rlt (inject_Q 1) (inject_Q 2).
exists O.
unfold Rpos_k.
unfold inject_Q; simpl; auto.
unfold Qle; simpl; auto with zarith.
Defined.

Require Import nat_log.

Lemma two_p_correct : forall (n:nat), 2^n == two_p n.
Proof.
induction n.
reflexivity.
QpowerSimpl.
rewrite IHn; clear IHn.
unfold Z_of_nat, two_p.
destruct n.
reflexivity.
simpl.
set (p:=P_of_succ_nat n).
unfold two_power_pos.
do 2 rewrite shift_pos_nat; unfold shift_nat.
rewrite <- Pplus_one_succ_r.
rewrite nat_of_P_succ_morphism.
simpl.
unfold Qeq.
simpl.
rewrite <- Pmult_assoc.
rewrite (Pmult_comm 2).
rewrite Pmult_assoc.
rewrite Pmult_comm.
reflexivity.
Qed.

(* The strict order is conserved when injecting Q in R. *)

Lemma Qlt_Rlt : forall a b, a<b -> Rlt (inject_Q a) (inject_Q b).
Proof.
intros a b; exists (nat_log_sup ((Qden b)*(Qden a))).
unfold Rpos_k.
unfold inject_Q; simpl; auto.
rewrite Qinv_power_n.
rewrite  two_p_correct.
rewrite log_sup_log_sup.
set (ab := (Qden b * Qden a)%positive) in *.
assert ('ab <= two_p (log_sup ab)).
 red; simpl; simpl_mult; destruct (log_sup_correct2 ab) as (_,H0); omega.
apply Qmult_lt_0_le_reg_r with (two_p (log_sup ab)).
apply Qlt_le_trans with ('ab); [compute|]; auto.
rewrite Qmult_comm.
rewrite Qmult_inv_r by (intro H1; rewrite H1 in H0; auto).
rewrite Qmult_comm.
apply Qle_trans with ('ab*(b+-a)); [|
 apply Qmult_le_compat_r; auto;
 rewrite <- Qle_minus_iff; apply Qlt_le_weak; auto].
unfold ab; red; simpl.
set (baab := ((Qnum b)*'(Qden a)+-(Qnum a)*'(Qden b))%Z).
assert (1 <= baab)%Z.
 unfold baab; rewrite <- Zopp_mult_distr_l; red in H; omega.
destruct baab.
(*baab = 0*)
elim H1; auto.
(*baab>0*)
simpl_mult.
rewrite Zmult_1_r.
assert (H2:=Zmult_le_compat (' Qden b * ' Qden a) 1 (' Qden b * ' Qden a) ('p)).
rewrite Zmult_1_r in H2.
apply H2; auto.
apply Zle_refl.
compute; intro; discriminate.
compute; intro; discriminate.
(*baab<0*)
elim H1; auto.
Defined.

(* Main part: we now build a sequence of nested intervals
   containing sqrt(2). *)

Record itvl : Set := { lft : Q ; rht : Q ; lft_rht : lft<rht}.
(*Print itvl. *)
(*Check itvl.*)

Definition two_three: itvl.
apply (Build_itvl 2 3).
unfold Qlt; simpl; auto with zarith.
Qed.

(*Check two_three.*)
(*Check (lft two_three).*)
(*Check lft_rht.*)
(*Check (lft_rht two_three).*)

Record itvl2: Set:= {lft1:Q; rht1:Q; lft2:Q; rht2:Q; lft1_rht1: lft1<rht1; lft2_rht2: lft2<rht2}.

Definition in_itvl := fun i x => lft i <= x <= rht i.
Definition in_itvl2 := fun i x =>  lft1 i<=x<=rht1 i /\ lft2 i<=x<=rht2 i.

Record continuous (i:itvl) : Set := {
   cont_h : Q -> nat -> Q;
   cont_alpha : nat -> nat;
   cont_w : nat -> nat;
   cont_cauchy: forall a, Is_Cauchy (cont_h a) cont_alpha;
   cont_unif : forall a b n k, le n (cont_alpha k) -> in_itvl i a -> in_itvl i b ->
       -(1#2)^(pred (cont_w k)) <= a-b <= (1#2)^(pred (cont_w k)) ->
       -(1#2)^k <= cont_h a n - cont_h b n <= (1#2)^k
}.

Definition one_two : itvl.
apply (Build_itvl 1 2).
unfold Qlt; simpl; auto with zarith.
Qed.

Definition sqr2_cont : continuous one_two.
apply (Build_continuous one_two sqr2_h sqr2_alpha sqr2_w).
fedup.
fedup.
Qed.

Require Zcomplements.

(* Coercion Zpos : positive >-> Z. *)

Definition sqrt2_approx : nat -> itvl.
induction 1.
apply (Build_itvl 1 2); unfold Qlt; simpl; omega.
elim IHnat; intros a b ab.
set (c:= (Qred ((2#3)*a+(1#3)*b))).
set (d:= (Qred ((1#3)*a+(2#3)*b))).
assert (cd : c<d).
   unfold c, d.
   rewrite Qlt_minus_iff in ab |- *.
   rewrite (Qred_correct ((2#3)*a+(1#3)*b)).
   rewrite (Qred_correct ((1#3)*a+(2#3)*b)).
   step (0*(1#3) <= (b+-a)*(1#3)).
   apply Qmult_lt_compat_r; [compute|]; auto.
set (fc := sqr2_apply (inject_Q c)).
set (fd := sqr2_apply (inject_Q d)).
assert (fcfd : Rlt fc fd).
  unfold fc, fd; apply sqr2_incr.
  fedup.
  fedup.
 apply Qlt_Rlt; auto.
case (Rcompare fc fd fcfd (inject_Q 0)); intros.
apply (Build_itvl c b).
  fedup.
apply (Build_itvl a d).
  fedup.
Defined.

(* The cauchy sequence giving sqrt(2) is finally obtained
    by the left borders of these intervals. *)

Definition sqrt2: R.
apply (Build_R (fun n => lft (sqrt2_approx n)) (fun k => plus k k)).
fedup.
Defined.

Extraction Inline Zcompare_rec Z_lt_rec.
Extraction "sqrt2.ml" sqrt2.


From Coq Require Import Lists.List.
From Coq Require Import Init.Nat.
From Coq Require Import Numbers.NatInt.NZDiv.
From Coq Require Import Numbers.NatInt.NZLog.
From Coq Require Import Numbers.NatInt.NZBits.
Require Import RuntimeDefinitions.
Require Import AppendixD.
Require Import AppendixF.

Definition lt_way_ID (c1: nullable_cachelet_index) (c2: nullable_cachelet_index) : nullable_cachelet_index :=
  match c1, c2 with
  | cachelet_index_defined v1, cachelet_index_defined v2 =>
    match v1, v2 with
    | (w1, _), (w2, _) =>
      if ltb w1 w2 then c1 else c2
    end
  | _, cachelet_index_none => c1
  | _, _ => c2
  end.

Definition nullify_cachelet_index (c: cachelet_index): nullable_cachelet_index := cachelet_index_defined c.
Definition nullify_cachelet_index_list (l: (list cachelet_index)): (list nullable_cachelet_index) :=
  map (nullify_cachelet_index) l.

(* Way First Allocation *)
Definition cachelet_min_way_ID (l: (list cachelet_index)): nullable_cachelet_index :=
  fold_right lt_way_ID cachelet_index_none (nullify_cachelet_index_list l).
Definition way_first_allocation (F: CAT): nullable_cachelet_index := cachelet_min_way_ID F.

(* Cachelet Invalidation*)
Definition cachelet_invalidation (C: way_set_cache) (ci: cachelet_index): way_set_cache :=
  match (CacheletMap.find ci C) with
  | Some (valid_bit_tag_and_data _ c d) => CacheletMap.add ci (valid_bit_tag_and_data dirty_bit c d) C
  | None => C
  end.

(* Beta Function *)
Inductive set_and_tag : Type :=
  | set_and_tag_values: set_ID -> cache_tag_value -> set_and_tag.
Definition block_to_set_and_tag (val: block_ID) (sets: set_indexed_PLRU) : set_and_tag :=
  set_and_tag_values (val mod (length (NatMapProperties.to_list sets))) (shiftr val (log2 (length (NatMapProperties.to_list sets)))).

(* Find Way ID *)
Fixpoint find_way_ID_in_mask (t: cache_tag_value) (s: set_ID) (W: way_mask) (C: way_set_cache): option way_ID :=
  match W with
  | nil => None
  | w :: W' =>
    match (CacheletMap.find (w, s) C) with
    | None => find_way_ID_in_mask t s W' C
    | Some cache_value =>
      match cache_value with
      | valid_bit_tag_and_data vb t' D =>
        match t =? t' with
        | true => Some w
        | false => find_way_ID_in_mask t s W' C
        end
      end
    end
  end.
Definition find_way_ID_with_cache_tag (state: enclave_state) (s: set_ID) (t: cache_tag_value) (V: VPT) (C: way_set_cache): option way_ID :=
  match state with
  | enclave_state_value e_id _ =>
    match e_id with
    | enclave_ID_inactive => None
    | enclave_ID_active e =>
      match (NatMap.find e V) with
      | None => None
      | Some L =>
        match (NatMap.find s L) with
        | None => None
        | Some W => find_way_ID_in_mask t s W C
        end
      end
    end
  end.

(* CC 'Unfold' Function(s) *)
Inductive validatable_cc_unfold : Type :=
| cc_unfold_valid: CAT -> VPT -> way_set_cache -> set_indexed_PLRU -> cachelet_index -> way_set_cache_value -> data_offset -> validatable_cc_unfold
| cc_unfold_error: validatable_cc_unfold.
Definition cc_unfold (psi: single_level_cache_unit) (state: enclave_state) (l: memory_address): validatable_cc_unfold :=
  match psi with
  | single_level_cache F V C R =>
    match l with
    | address b delta =>
      match (block_to_set_and_tag b R) with
      | set_and_tag_values s t =>
        match (find_way_ID_with_cache_tag state s t V C) with
        | None => cc_unfold_error
        | Some w =>
          match (CacheletMap.find (w, s) C) with
          | None => cc_unfold_error
          | Some cache_val => cc_unfold_valid F V C R (w, s) cache_val delta
          end
        end
      end
    end
  end.

(* CC Hit Read *)
Inductive validatable_cc_hit_read : Type :=
  | cc_hit_read_valid: data_block -> data_offset -> cachelet_index -> single_level_cache_unit -> validatable_cc_hit_read
  | cc_hit_read_error: validatable_cc_hit_read.
Definition cc_hit_read (psi: single_level_cache_unit) (state: enclave_state) (l: memory_address): validatable_cc_hit_read :=
  match (cc_unfold psi state l) with
  | cc_unfold_error => cc_hit_read_error
  | cc_unfold_valid F V C R (w, s) cache_val delta =>
    match cache_val with
    | valid_bit_tag_and_data _ _ D =>
      match (NatMap.find s R) with
      | None => cc_hit_read_error
      | Some T' =>
        match state with
        | enclave_state_value e _ => cc_hit_read_valid D delta (w, s) (single_level_cache F V C (NatMap.add s (update T' w e) R))
        end
      end
    end
  end.

(* CC Hit Write *)
Inductive validatable_cc_hit_write : Type :=
  | cc_hit_write_valid: data_block -> cachelet_index -> single_level_cache_unit -> validatable_cc_hit_write
  | cc_hit_write_error: validatable_cc_hit_write.
Definition cc_hit_write (psi: single_level_cache_unit) (state: enclave_state) (l: memory_address) (v: memory_value): validatable_cc_hit_write :=
  match (cc_unfold psi state l) with
  | cc_unfold_error => cc_hit_write_error
  | cc_unfold_valid F V C R (w, s) cache_val delta =>
    match cache_val with
    | valid_bit_tag_and_data _ t D =>
      match (NatMap.find s R) with
      | None => cc_hit_write_error
      | Some T' =>
        match v with
        | memory_value_instruction _ => cc_hit_write_error
        | memory_value_data n =>
          match state with
          | enclave_state_value e _ => cc_hit_write_valid D (w, s) (single_level_cache F V (CacheletMap.add (w, s) (valid_bit_tag_and_data dirty_bit t (NatMap.add delta (memory_value_data n) D)) C) (NatMap.add s (update T' w e) R))
          end
        end
      end
    end
  end.

(* CC Update *)
Inductive validatable_cc_update : Type :=
  | cc_update_valid: cachelet_index -> single_level_cache_unit -> validatable_cc_update
  | cc_update_error: validatable_cc_update.
Definition cc_update (psi: single_level_cache_unit) (state: enclave_state) (D: data_block) (l: memory_address): validatable_cc_update :=
  match (cc_unfold psi state l) with
  | cc_unfold_error => cc_update_error
  | cc_unfold_valid F V C R (w, s) cache_val _ =>
    match cache_val with
    | valid_bit_tag_and_data _ t _ =>
      match state with
      | enclave_state_value e _ =>
        match (NatMap.find s R) with
        | None => cc_update_error
        | Some T' =>
          match (replace T' e) with
          | None => cc_update_error
          | Some w' => cc_update_valid (w, s) (single_level_cache F V (CacheletMap.add (w, s) (valid_bit_tag_and_data valid_bit t D) C) (NatMap.add s (update T' w e) R))
          end
        end
      end
    end
  end.

(* Cachelet Allocation *)
Fixpoint recursive_cachelet_allocation (n: nat) (e: raw_enclave_ID) (F: CAT) (V: VPT) (C: way_set_cache) (R: set_indexed_PLRU): option single_level_cache_unit :=
  match n with
  | 0 => Some (single_level_cache F V C R)
  | S n' =>
    match way_first_allocation F with
    | cachelet_index_none => None
    | cachelet_index_defined (w, s) =>
      match (NatMap.find s R) with
      | None => None
      | Some T' =>
        match (NatMap.find e V) with
        | None => recursive_cachelet_allocation n' e (remove_CAT (w, s) F) (NatMap.add e (NatMap.add s (w :: nil) (NatMap.empty (list way_ID))) V) C (NatMap.add s (update T' w (enclave_ID_active e)) R)
        | Some L =>
          match (NatMap.find s L) with
          | None => recursive_cachelet_allocation n' e (remove_CAT (w, s) F) (NatMap.add e (NatMap.add s (w :: nil) L) V) C (NatMap.add s (update T' w (enclave_ID_active e)) R)
          | Some W => recursive_cachelet_allocation n' e (remove_CAT (w, s) F) (NatMap.add e (NatMap.add s (w :: W) L) V) C (NatMap.add s (update T' w (enclave_ID_active e)) R)
          end
        end
      end
    end
  end.
Definition cachelet_allocation (n: nat) (e: raw_enclave_ID) (psi: single_level_cache_unit): option single_level_cache_unit :=
  match psi with
  | single_level_cache F V C R => recursive_cachelet_allocation n e F V C R
  end.

(* Cachelet Deallocation *)
Fixpoint free_cachelets (e: raw_enclave_ID) (s: set_ID) (W: way_mask) (F: CAT) (V: VPT) (C: way_set_cache) (R: set_indexed_PLRU): option single_level_cache_unit :=
  match W with
  | nil => Some (single_level_cache F V C R)
  | w :: W' =>
    match (NatMap.find s R) with
    | None => None
    | Some T' => (free_cachelets e s W' ((w, s) :: F) V (cachelet_invalidation C (w, s)) (NatMap.add s (update T' w (enclave_ID_active e)) R))
    end
  end.
Fixpoint clear_remapping_list (e: raw_enclave_ID) (L: list (set_ID * way_mask % type)) (F: CAT) (V: VPT) (C: way_set_cache) (R: set_indexed_PLRU): option single_level_cache_unit :=
  match L with
  | nil => Some (single_level_cache F (NatMap.remove e V) C R)
  | (s, W) :: L' =>
    match (free_cachelets e s W F V C R) with
    | None => None
    | Some psi' =>
      match psi' with
      | single_level_cache F' V' C' R' => clear_remapping_list e L' F' V' C' R'
      end
    end
  end.
Definition cachelet_deallocation (e: raw_enclave_ID) (psi: single_level_cache_unit): option single_level_cache_unit :=
  match psi with
  | single_level_cache F V C R =>
    match (NatMap.find e V) with
    | None => None
    | Some L => clear_remapping_list e (NatMapProperties.to_list L) F V C R
    end
  end.


Require Export CatSem.CAT.ind_potype.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Transparent Obligations.
Unset Automatic Introduction.

(** for module M, we define [IPO_Der_Mod M], the derived module *)

Section fixatype.

Variable T : Type.

Section Der_Module.

Variable P : Monad (IPO T).
(*
Variable obD : Type.
Variable morD : obD -> obD -> Type.
Variable D: Cat morD.
*)
Variable D : Cat.
Section Der_Module_def.

Variable M : MOD P D.

Obligation Tactic := idtac.

Program Instance IPO_Der_Mod_struct (u:T) :
        Module_struct P (fun V => M (opt_TP u V)) := {
  mkleisli a b f := (mkleisli (M:=M)(opt_TP_def_varinj u f))
}.
Next Obligation.
Proof.
  unfold Proper; red.
  intros u c d z y H.
  apply mkleisli_oid.
  simpl; intros.
  elim_opt.
  rewrite H;
  auto.
Qed.
Obligation 3.
Proof.
  intros; simpl.
  rewrite opt_TP_def_varinj_weta.
  mod.
Qed.
Next Obligation.
Proof.
  simpl; intros.
  rewrite mkl_mkl.
  apply mkleisli_oid.
  unfold opt_TP_def_varinj.
  simpl; intros.
  elim_opt.
  rew (lift_kleisli (M:=P)).
  rew (kleisli_lift (M:=P)).
  apply (kl_eq P).
  simpl; auto.

  rew (eta_kl (Monad_struct := P)).
Qed.

Canonical Structure IPO_Der_Mod (u:T) : MOD P D :=
      Build_Module (IPO_Der_Mod_struct u).

End Der_Module_def.

(** deriving a module wrt u:T yields a functor *)

Section Der_Module_Functor.

Section Der_Mod_Hom.

Variables M N: MOD P D.
Variable TT : M ---> N.

Obligation Tactic := simpl; mod; try apply TT.

Program Instance Der_Mod_Hom_struct (u:T) :
  Module_Hom_struct (S:=IPO_Der_Mod M u) (T:=IPO_Der_Mod N u)
            (fun _ => TT (*opt_TP u x*) _ ) .

Canonical Structure Der_Mod_Hom (u:T) :
     IPO_Der_Mod M u ---> IPO_Der_Mod N u :=
           Build_Module_Hom
           (Der_Mod_Hom_struct u).

End Der_Mod_Hom.

Obligation Tactic := simpl; intros;
    try (match goal with [|-Proper _ _ ] => unfold Proper; red end);
    cat.

Program Instance Der_Mod_Func (u:T) :
   Functor_struct (C:=MOD P D) (D:=MOD P D)
        (Fobj:= fun z => IPO_Der_Mod z u)
        (fun M N TT => Der_Mod_Hom (M:=M) (N:=N) TT u).

Canonical Structure DER_MOD (u:T) := Build_Functor (Der_Mod_Func u).

End Der_Module_Functor.

End Der_Module.

Section Fibre_module.

Variable P: Monad (IPO T).

Section Fibre_Module_def.

Variable M : MOD P (IPO T).

Obligation Tactic :=
    cat;
    try (match goal with [|- Proper _ _ ] => do 2 red end);
    cat;
    try apply (mkl_eq M);
    try rew (mklmkl M); try rew (mklweta (P:=P) (M:=M)); auto.

Program Instance Fibre_Mod_struct (u:T) :
       Module_struct P  (fun c => IP_proj u (M c)) := {
  mkleisli a b f := #(IP_proj u) (@mkleisli _ P  _ M M  a b f)
}.

Canonical Structure Fibre_Mod (u:T) : MOD P Ord :=
           Build_Module (Fibre_Mod_struct u).

End Fibre_Module_def.

Section Fibre_Module_Hom.
Variables M N : MOD P (IPO T).
Variable TT : M ---> N.

Obligation Tactic := simpl; intros;
   rew (mod_hom_mkl (Module_Hom_struct := TT)).

Program Instance Fib_Mod_Hom_struct (u:T) :
   Module_Hom_struct (S:= Fibre_Mod M u )(T:= Fibre_Mod N u)
    (fun z => #(IP_proj u) (TT z) ).

Canonical Structure Fib_Mod_Hom (u:T) :
     Fibre_Mod M u ---> Fibre_Mod N u :=
        Build_Module_Hom (Fib_Mod_Hom_struct u).

End Fibre_Module_Hom.

Obligation Tactic := repeat red; simpl; auto.

Program Instance Fib_Mod_Func (u:T) :
   Functor_struct (C:=MOD P (IPO T)) (D:=MOD P Ord)
        (Fobj:= fun x => Fibre_Mod x u)
        (fun M N TT => Fib_Mod_Hom (M:=M) (N:=N) TT u).

Canonical Structure FIB_MOD (u:T) := Build_Functor (Fib_Mod_Func u).

End Fibre_module.

Section DER_PB.

Notation "Sig '*' M" := (PB_MOD Sig _ M).
Variables R S: Monad (IPO T).
Variable Sig: Monad_Hom R S.
(*
Variable obD: Type.
Variable morD: obD -> obD -> Type.
Variable D: Cat morD.
*)
Variable D : Cat.
Variable M: MOD S D.

Obligation Tactic := cat;
    apply mkleisli_oid; simpl; intros; elim_opt;
    try rew (monad_hom_lift Sig);
    rew(monad_hom_weta (Monad_Hom_struct := Sig)).

Program Instance PB_DER_struct (u:T) :
  Module_Hom_struct
      (S:= (PB_MOD Sig _ (DER_MOD _ _ u M)))
      (T:= DER_MOD _ _ u (PB_MOD Sig _ M))
          (fun e => id _) .

Definition PB_DER (u:T) : PB_MOD Sig _ (DER_MOD _ _ u M) --->
                            DER_MOD _ _ u (PB_MOD Sig _ M) :=
         Build_Module_Hom (PB_DER_struct u).

Program Instance DER_PB_struct (u:T) :
  Module_Hom_struct
    (T:= (PB_MOD Sig _ (DER_MOD _ _ u M)))
    (S:= DER_MOD _ _ u (PB_MOD Sig _ M))
          (fun e => id _) .

Definition DER_PB (u:T) : DER_MOD _ _ u (PB_MOD Sig _ M) --->
                  PB_MOD Sig _ (DER_MOD _ _ u M) :=
         Build_Module_Hom (DER_PB_struct u).

Lemma DER_PB_PB_DER (u:T) : DER_PB u ;; PB_DER u == id _ .
Proof.
  cat.
Qed.

Lemma PB_DER_DER_PB (u:T) : PB_DER u ;; DER_PB u == id _.
Proof.
  cat.
Qed.

End DER_PB.

Section FIB_PB.

Notation "Sig '*' M" := (PB_MOD Sig _ M).
Variables R S: Monad (IPO T).
Variable Sig: Monad_Hom R S.
(*
Variable obD: Type.
Variable morD: obD -> obD -> Type.
Variable D: Cat morD.
*)
Variable M: MOD S (IPO T).

Obligation Tactic := cat.

Program Instance PB_FIB_struct (u:T) :
   Module_Hom_struct
   (S:= (PB_MOD Sig _ (FIB_MOD _ u M)))
   (T:= FIB_MOD _ u (PB_MOD Sig _ M))
          (fun e => id _) .

Definition PB_FIB (u:T) :
PB_MOD Sig _ (FIB_MOD _ u M) ---> FIB_MOD _ u (PB_MOD Sig _ M) :=
          Build_Module_Hom (PB_FIB_struct u).

Program Instance FIB_PB_struct (u:T) :
  Module_Hom_struct
   (T:= (PB_MOD Sig _ (FIB_MOD _ u M)))
   (S:= FIB_MOD _ u (PB_MOD Sig _ M))
          (fun e => id _) .

Definition FIB_PB (u:T) :
FIB_MOD _ u (PB_MOD Sig _ M) ---> PB_MOD Sig _ (FIB_MOD _ u M) :=
          Build_Module_Hom (FIB_PB_struct u).

Lemma FIB_PB_PB_FIB (u:T) :
          FIB_PB u ;; PB_FIB u == id _ .
Proof.
  cat.
Qed.

Lemma PB_FIB_FIB_PB (u:T) :
          PB_FIB u ;; FIB_PB u == id _ .
Proof.
  cat.
Qed.

End FIB_PB.

End fixatype.

Existing Instance Fib_Mod_Func.


Require Import Bool String List Arith.Peano_dec Lia.
Require Import Lib.FMap Lib.Struct Lib.CommonTactics Lib.Indexer Lib.StringEq Lib.ListSupport.
Require Import Kami.Syntax Kami.Semantics Kami.SemFacts Kami.RefinementFacts Kami.Renaming Kami.Wf.
Require Import Kami.Specialize.

Require Import FunctionalExtensionality.
Require Import Compare_dec.

Set Implicit Arguments.
Set Asymmetric Patterns.

Section Duplicate.
  Variable m: nat -> Modules.

  Fixpoint duplicate n :=
    match n with
    | O => specializeMod (m O) O
    | S n' => ConcatMod (specializeMod (m n) n) (duplicate n')
    end.

End Duplicate.

Section DuplicateFacts.
  Variable m: nat -> Modules.

  Lemma duplicate_ModEquiv:
    forall ty1 ty2 n,
      (forall iv, ModEquiv ty1 ty2 (m iv)) ->
      ModEquiv ty1 ty2 (duplicate m n).
  Proof.
    induction n; simpl; intros;
      [apply specializeMod_ModEquiv; auto|].
    apply ModEquiv_modular; auto.
    apply specializeMod_ModEquiv; auto.
  Qed.

  Lemma duplicate_validRegsModules:
    forall n,
      (forall iv, ValidRegsModules type (m iv)) ->
      ValidRegsModules type (duplicate m n).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_validRegsModules; auto.
    - split; auto.
      apply specializeMod_validRegsModules; auto.
  Qed.

  Lemma duplicate_dom_indexed:
    (forall iv, Specializable (m iv)) ->
    forall s n ,
      In s (spDom (duplicate m n)) ->
      exists t i, s = t __ i /\ i < S n.
  Proof.
    induction n; simpl; intros.
    - pose proof (specializeMod_dom_indexed (H 0) _ _ H0); dest; subst.
      do 2 eexists; eauto.
    - apply spDom_in in H0; destruct H0.
      + pose proof (specializeMod_dom_indexed (H (S n)) _ _ H0); dest; subst.
        do 2 eexists; eauto.
      + specialize (IHn H0); dest; subst.
        do 2 eexists; eauto.
  Qed.

  Lemma duplicate_specializeMod_disj_regs:
    (forall iv, Specializable (m iv)) ->
    forall n ln iv,
      ln > n ->
      DisjList (namesOf (getRegInits (specializeMod (m iv) ln)))
               (namesOf (getRegInits (duplicate m n))).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_disj_regs_different_indices; auto; lia.
    - unfold namesOf in *.
      rewrite map_app.
      apply DisjList_comm, DisjList_app_4.
      + apply specializeMod_disj_regs_different_indices; auto; lia.
      + apply DisjList_comm, IHn; lia.
  Qed.

  Lemma duplicate_specializeMod_disj_defs:
    (forall iv, Specializable (m iv)) ->
    forall n ln iv,
      ln > n ->
      DisjList (getDefs (specializeMod (m iv) ln))
               (getDefs (duplicate m n)).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_disj_defs_different_indices; auto; lia.
    - apply DisjList_comm.
      apply DisjList_SubList with
      (l1:= app (getDefs (specializeMod (m (S n)) (S n)))
                (getDefs (duplicate m n))).
      + unfold SubList; intros.
        apply getDefs_in in H1; destruct H1;
          apply in_or_app; auto.
      + apply DisjList_app_4.
        * apply specializeMod_disj_defs_different_indices; auto; lia.
        * apply DisjList_comm, IHn; lia.
  Qed.

  Lemma duplicate_specializeMod_disj_calls:
    (forall iv, Specializable (m iv)) ->
    forall n ln iv,
      ln > n ->
      DisjList (getCalls (specializeMod (m iv) ln))
               (getCalls (duplicate m n)).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_disj_calls_different_indices; auto; lia.
    - apply DisjList_comm.
      apply DisjList_SubList with
      (l1:= app (getCalls (specializeMod (m (S n)) (S n)))
                (getCalls (duplicate m n))).
      + unfold SubList; intros.
        apply getCalls_in in H1; destruct H1;
          apply in_or_app; auto.
      + apply DisjList_app_4.
        * apply specializeMod_disj_calls_different_indices; auto; lia.
        * apply DisjList_comm, IHn; lia.
  Qed.

  Lemma duplicate_disj_regs:
    forall m1 m2,
      (forall iv1, Specializable (m1 iv1)) ->
      (forall iv2, Specializable (m2 iv2)) ->
      (forall iv1 iv2, DisjList (namesOf (getRegInits (m1 iv1)))
                                (namesOf (getRegInits (m2 iv2)))) ->
      forall n,
        DisjList (namesOf (getRegInits (duplicate m1 n)))
                 (namesOf (getRegInits (duplicate m2 n))).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_disj_regs_2; auto.
    - unfold namesOf; do 2 rewrite map_app; apply DisjList_app_4.
      + apply DisjList_comm, DisjList_app_4.
        * apply DisjList_comm, specializeMod_disj_regs_2; auto.
        * clear IHn.
          assert (n < S n) by lia.
          generalize dependent (S n); intros.
          induction n; simpl; intros.
          { apply DisjList_comm, specializeMod_disj_regs_2; auto. }
          { rewrite map_app; apply DisjList_app_4.
            { apply DisjList_comm, specializeMod_disj_regs_2; auto. }
            { apply IHn; lia. }
          }
      + apply DisjList_comm, DisjList_app_4.
        * clear IHn.
          assert (n < S n) by lia.
          generalize dependent (S n); intros.
          induction n; simpl; intros.
          { apply DisjList_comm, specializeMod_disj_regs_2; auto. }
          { rewrite map_app; apply DisjList_comm, DisjList_app_4.
            { apply specializeMod_disj_regs_2; auto. }
            { apply DisjList_comm; auto.
              apply IHn; lia.
            }
          }
        * apply DisjList_comm, IHn.
  Qed.

  Lemma duplicate_noninteracting:
    (forall iv, Specializable (m iv)) ->
    forall n ln,
      ln > n ->
      forall iv,
        NonInteracting (specializeMod (m iv) ln)
                       (duplicate m n).
  Proof.
    induction n; simpl; intros.
    - apply specializable_noninteracting_2; auto; lia.
    - unfold NonInteracting in *.
      assert (ln > n) by lia; specialize (IHn _ H1); clear H1; dest.
      split.
      + apply DisjList_comm.
        apply DisjList_SubList with
        (l1:= app (getCalls (specializeMod (m (S n)) (S n)))
                  (getCalls (duplicate m n))).
        * unfold SubList; intros.
          apply getCalls_in in H1.
          apply in_or_app; auto.
        * apply DisjList_app_4.
          { pose proof (specializable_noninteracting_2 (H (S n)) (H iv)).
            apply H1; lia.
          }
          { specialize (IHn iv); dest.
            apply DisjList_comm; auto.
          }
      + apply DisjList_comm.
        apply DisjList_SubList with
        (l1:= app (getDefs (specializeMod (m (S n)) (S n)))
                  (getDefs (duplicate m n))).
        * unfold SubList; intros.
          apply getDefs_in in H1.
          apply in_or_app; auto.
        * apply DisjList_app_4.
          { pose proof (specializable_noninteracting_2 (H (S n)) (H iv)).
            apply H1; lia.
          }
          { specialize (IHn iv); dest.
            apply DisjList_comm; auto.
          }
  Qed.

  Lemma duplicate_regs_NoDup:
    forall (Hsp: forall iv, Specializable (m iv)) n,
      (forall iv, NoDup (namesOf (getRegInits (m iv)))) ->
      NoDup (namesOf (getRegInits (duplicate m n))).
  Proof.
    induction n; simpl; intros; [apply specializeMod_regs_NoDup; auto|].
    unfold namesOf in *; simpl in *.
    rewrite map_app; apply NoDup_DisjList; auto.
    - apply specializeMod_regs_NoDup, H; auto.
    - apply duplicate_specializeMod_disj_regs; auto.
  Qed.

  Lemma getRegInits_duplicate_nil:
    forall n,
      (forall iv, Specializable (m iv)) ->
      (forall iv, getRegInits (m iv) = nil) ->
      getRegInits (duplicate m n) = nil.
  Proof.
    intros.
    match goal with
    | [ |- ?P ] => assert (namesOf (getRegInits (duplicate m n)) = nil -> P) as Hm
    end.
    { intros; unfold namesOf in H1; eapply map_eq_nil; eauto. }
    apply Hm; clear Hm.

    induction n; simpl; intros.
    - rewrite specializeMod_regs; auto.
      rewrite H0; reflexivity.
    - rewrite namesOf_app.
      rewrite IHn; rewrite app_nil_r.
      rewrite specializeMod_regs; auto.
      rewrite H0; reflexivity.
  Qed.

  Lemma getDefs_duplicate_nil:
    (forall iv, Specializable (m iv)) ->
    (forall iv, getDefs (m iv) = nil) ->
    forall n,
      getDefs (duplicate m n) = nil.
  Proof.
    induction n; simpl; intros.
    - rewrite specializeMod_defs; auto.
      rewrite H0; reflexivity.
    - rewrite getDefs_app.
      rewrite IHn; rewrite app_nil_r.
      rewrite specializeMod_defs; auto.
      rewrite H0; reflexivity.
  Qed.

  Lemma getDefsBodies_duplicate_nil:
    (forall iv, Specializable (m iv)) ->
    (forall iv, getDefsBodies (m iv) = nil) ->
    forall n,
      getDefsBodies (duplicate m n) = nil.
  Proof.
    intros.
    assert (forall iv, getDefs (m iv) = nil) by (intros; unfold getDefs; rewrite H0; reflexivity).
    eapply getDefs_duplicate_nil with (n:= n) in H1; eauto.
    eapply map_eq_nil with (f:= @attrName _); eauto.
  Qed.

  Lemma getRules_duplicate_in:
    forall rn rb i,
      (forall iv, Specializable (m iv)) ->
      In (rn :: rb)%struct (getRules (m i)) ->
      forall n,
        i <= n ->
        In ((rn __ i)
              :: (fun ty => (Renaming.renameAction (specializer (m i) i) (rb ty))))%struct
           (getRules (duplicate m n)).
  Proof.
    induction n; simpl; intros.
    - inv H1; apply specializeMod_rules_in; auto.
    - inv H1; [|apply in_or_app; right; auto].
      apply in_or_app; left.
      apply specializeMod_rules_in; auto.
  Qed.

End DuplicateFacts.

Section TwoModules1.
  Variables (m1 m2: Modules).
  Hypotheses (Hsp1: Specializable m1)
             (Hsp2: Specializable m2)
             (Hequiv1: ModEquiv type typeUT m1)
             (Hequiv2: ModEquiv type typeUT m2)
             (Hvr1: ValidRegsModules type m1)
             (Hvr2: ValidRegsModules type m2)
             (Hexts: SubList (getExtMeths m1) (getExtMeths m2)).

  Lemma specializer_equiv:
    forall {A} (m: M.t A),
      M.KeysSubset m (spDom m1) ->
      M.KeysSubset m (spDom m2) ->
      forall i,
        renameMap (specializer m1 i) m = renameMap (specializer m2 i) m.
  Proof. intros; do 2 (rewrite specializer_map; auto). Qed.

  Lemma specializeMod_defCallSub:
    forall i,
      DefCallSub m1 m2 ->
      DefCallSub (specializeMod m1 i) (specializeMod m2 i).
  Proof.
    unfold DefCallSub; intros; dest; split.
    - do 2 rewrite specializeMod_defs by assumption.
      apply SubList_map; auto.
    - do 2 rewrite specializeMod_calls by assumption.
      apply SubList_map; auto.
  Qed.

  Lemma specializer_two_comm:
    forall (m: MethsT),
      M.KeysSubset m (getExtMeths m1) ->
      forall i,
        m = renameMap (specializer m2 i) (renameMap (specializer m1 i) m).
  Proof.
    intros.
    replace (renameMap (specializer m1 i) m) with (renameMap (specializer m2 i) m).
    - rewrite renameMapFInvG; auto.
      + apply specializer_bijective.
        apply specializable_disj_dom_img; auto.
      + apply specializer_bijective.
        apply specializable_disj_dom_img; auto.
    - apply eq_sym, specializer_equiv.
      + eapply M.KeysSubset_SubList; eauto.
        pose proof (getExtMeths_meths m1).
        apply SubList_trans with (l2:= app (getDefs m1) (getCalls m1)); auto.
        apply SubList_app_3; [apply spDom_defs|apply spDom_calls].
      + apply M.KeysSubset_SubList with (d2:= getExtMeths m2) in H; auto.
        eapply M.KeysSubset_SubList; eauto.
        pose proof (getExtMeths_meths m2).
        apply SubList_trans with (l2:= app (getDefs m2) (getCalls m2)); auto.
        apply SubList_app_3; [apply spDom_defs|apply spDom_calls].
  Qed.

End TwoModules1.

Section DuplicateTwoModules1.
  Variables (m1 m2: nat -> Modules).
  Hypotheses (Hsp1: forall iv, Specializable (m1 iv))
             (Hsp2: forall iv, Specializable (m2 iv))
             (Hequiv1: forall iv, ModEquiv type typeUT (m1 iv))
             (Hequiv2: forall iv, ModEquiv type typeUT (m2 iv))
             (Hvr1: forall iv, ValidRegsModules type (m1 iv))
             (Hvr2: forall iv, ValidRegsModules type (m2 iv))
             (Hexts: forall iv1 iv2, SubList (getExtMeths (m1 iv1)) (getExtMeths (m2 iv2))).

  Lemma duplicate_defCallSub:
    forall n,
      (forall i, DefCallSub (m1 i) (m2 i)) ->
      DefCallSub (duplicate m1 n) (duplicate m2 n).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_defCallSub; auto.
    - apply DefCallSub_modular.
      + apply specializeMod_defCallSub; auto.
      + apply IHn; auto.
  Qed.

  Lemma duplicate_traceRefines:
    forall n,
      (forall i, traceRefines (liftToMap1 (@idElementwise _)) (m1 i) (m2 i)) ->
      traceRefines (liftToMap1 (@idElementwise _))
                   (duplicate m1 n)
                   (duplicate m2 n).
  Proof.
    induction n; simpl; intros.
    - apply specialized_2 with (i:= O); auto.
      specialize (H 0).
      eapply traceRefines_label_map; eauto using H.
      clear - Hsp1 Hsp2 Hexts; unfold EquivalentLabelMap; intros.
      rewrite idElementwiseId; unfold id; simpl.
      unfold liftPRename; simpl.
      apply specializer_two_comm; auto.

    - apply traceRefines_modular_noninteracting; auto.
      + apply specializeMod_ModEquiv; auto.
      + apply specializeMod_ModEquiv; auto.
      + apply duplicate_ModEquiv; auto.
      + apply duplicate_ModEquiv; auto.
      + apply duplicate_specializeMod_disj_regs; auto.
      + apply duplicate_specializeMod_disj_regs; auto.
      + pose proof (duplicate_validRegsModules m1 (S n) Hvr1); auto.
      + pose proof (duplicate_validRegsModules m2 (S n) Hvr2); auto.
      + apply duplicate_specializeMod_disj_defs; auto.
      + eapply DisjList_comm, DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply DisjList_comm, duplicate_specializeMod_disj_calls; auto.
      + eapply DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply duplicate_specializeMod_disj_calls; auto.
      + apply duplicate_specializeMod_disj_defs; auto.
      + eapply DisjList_comm, DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply DisjList_comm, duplicate_specializeMod_disj_calls; auto.
      + eapply DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply duplicate_specializeMod_disj_calls; auto.
      + apply duplicate_noninteracting; auto.
      + apply duplicate_noninteracting; auto.
      + apply specialized_2 with (i:= S n); auto.
        specialize (H (S n)).
        eapply traceRefines_label_map; eauto using H.
        clear - Hsp1 Hsp2 Hexts; unfold EquivalentLabelMap; intros.
        rewrite idElementwiseId; unfold id; simpl.
        unfold liftPRename; simpl.
        apply specializer_two_comm; auto.
  Qed.

End DuplicateTwoModules1.

Section TwoModules2.
  Variables (m1 m2: Modules).
  Hypotheses (Hsp1: Specializable m1)
             (Hsp2: Specializable m2)
             (Hequiv1: ModEquiv type typeUT m1)
             (Hequiv2: ModEquiv type typeUT m2)
             (Hvr1: ValidRegsModules type m1)
             (Hvr2: ValidRegsModules type m2).

  Variable (ds: string). (* a single label to drop *)

  Hypothesis (Hexts: SubList (filter (fun s => negb (string_eq s ds)) (getExtMeths m1))
                             (getExtMeths m2)).

  Lemma specializeMod_traceRefines_drop:
    forall i,
      (m1 <<=[dropP ds] m2) ->
      (specializeMod m1 i <<=[dropI ds i] specializeMod m2 i).
  Proof.
    intros.
    apply specialized_2; auto.
    apply traceRefines_label_map with (p:= liftToMap1 (dropP ds)); auto.

    clear -Hsp1 Hsp2 Hexts.
    unfold EquivalentLabelMap; intros.

    unfold liftPRename.

    assert (renameMap (specializer m2 i) ((liftToMap1 (dropP ds)) m) =
            liftToMap1 (dropI ds i) (renameMap (specializer m1 i) m)).
    { rewrite specializer_map with (m:= m1); auto;
        [|eapply M.KeysSubset_SubList; eauto; apply spDom_getExtMeths].
      rewrite specializer_map with (m:= m2); auto;
        [|apply M.KeysSubset_SubList with (d1:= getExtMeths m2); [|apply spDom_getExtMeths];
          eapply M.KeysSubset_SubList; eauto;
          apply dropP_KeysSubset; auto].

      clear; M.ext y.
      rewrite liftToMap1_find.
      remember (M.find y (renameMap (spf i) m)) as yiv; destruct yiv.
      - apply eq_sym, renameFind2' in Heqyiv; [|apply spf_onto].
        dest; subst; rewrite <-renameMapFind; [|apply spf_onto].
        rewrite liftToMap1_find, H0.
        unfold dropP, dropI.
        remember (string_eq x ds) as xds; destruct xds.
        + apply string_eq_dec_eq in Heqxds; subst.
          rewrite string_eq_true; reflexivity.
        + apply string_eq_dec_neq in Heqxds.
          remember (string_eq (spf i x) (ds __ i)) as xdsi; destruct xdsi; auto.
          apply string_eq_dec_eq, spf_onto in Heqxdsi.
          elim Heqxds; auto.
      - remember (M.find y (renameMap (spf i) (liftToMap1 (dropP ds) m))) as ypv;
          destruct ypv; auto.
        exfalso; apply eq_sym, renameFind2' in Heqypv; [|apply spf_onto].
        dest; subst.
        rewrite <-renameMapFind in Heqyiv; [|apply spf_onto].
        rewrite liftToMap1_find in H0.
        rewrite <-Heqyiv in H0; inv H0.
    }

    rewrite <-H0.
    rewrite <-specializer_two_comm with (m1:= m2) (m2:= m2) (i:= i); auto.
    - apply SubList_refl.
    - eapply M.KeysSubset_SubList; eauto.
      apply dropP_KeysSubset; auto.
  Qed.

  Lemma equivalentLabelMapElem_dropI_dropN:
    forall n t (Ht: t > n),
      EquivalentLabelMapElem (dropI ds t) (compLabelMaps (dropI ds t) (dropN ds n))
                             (getExtMeths (specializeMod m1 t)).
  Proof.
    unfold EquivalentLabelMapElem; intros.
    induction n.
    - simpl; unfold compLabelMaps, dropI.
      destruct (string_eq _ (ds __ t)).
      + destruct (string_eq _ (ds __ 0)); auto.
      + remember (string_eq _ _) as sv; destruct sv; auto.
        exfalso; apply string_eq_dec_eq in Heqsv; subst.
        apply spDom_getExtMeths in H.
        apply specializeMod_dom_indexed in H; auto; dest.
        apply withIndex_index_eq in H; dest; lia.
    - simpl; assert (t > n) by lia; specialize (IHn H0); clear H0.
      rewrite IHn; clear IHn.
      unfold dropI, compLabelMaps.
      remember (dropN ds n s v) as nv; destruct nv; auto.
      destruct (string_eq s (ds __ t)).
      + destruct (string_eq _ _); auto.
      + remember (string_eq _ _) as sn; destruct sn; auto.
        exfalso; apply string_eq_dec_eq in Heqsn; subst.
        apply spDom_getExtMeths in H.
        apply specializeMod_dom_indexed in H; auto; dest.
        apply withIndex_index_eq in H; dest; lia.
  Qed.

End TwoModules2.

Section DuplicateTwoModules2.
  Variables (m1 m2: nat -> Modules).
  Hypotheses (Hsp1: forall iv, Specializable (m1 iv))
             (Hsp2: forall iv, Specializable (m2 iv))
             (Hequiv1: forall iv, ModEquiv type typeUT (m1 iv))
             (Hequiv2: forall iv, ModEquiv type typeUT (m2 iv))
             (Hvr1: forall iv, ValidRegsModules type (m1 iv))
             (Hvr2: forall iv, ValidRegsModules type (m2 iv)).

  Variable (ds: string). (* a single label to drop *)

  Hypothesis (Hexts: forall iv1 iv2,
                 SubList (filter (fun s => negb (string_eq s ds))
                                 (getExtMeths (m1 iv1)))
                         (getExtMeths (m2 iv2))).

  Lemma equivalentLabelMapElem_dropN_dropI:
    forall n u (Ht: u > n),
      EquivalentLabelMapElem (dropN ds n) (compLabelMaps (dropI ds u) (dropN ds n))
                             (getExtMeths (duplicate m1 n)).
  Proof.
    induction n; unfold EquivalentLabelMapElem; intros.
    - simpl; unfold compLabelMaps, dropI.
      destruct (string_eq _ (ds __ 0)); auto.
      remember (string_eq _ _) as st; destruct st; auto.
      apply string_eq_dec_eq in Heqst; subst.
      simpl in H.
      apply spDom_getExtMeths in H.
      apply specializeMod_dom_indexed in H; auto; dest.
      apply withIndex_index_eq in H; dest; lia.
    - simpl; assert (u > n) by lia; specialize (IHn _ H0); clear H0.
      simpl in H.
      apply getExtMeths_in in H; destruct H.
      + clear IHn.
        unfold dropI, compLabelMaps.
        destruct (dropN ds n s v); auto.
        destruct (string_eq _ (ds __ (S n))); auto.
        remember (string_eq _ _) as st; destruct st; auto.
        exfalso; apply string_eq_dec_eq in Heqst; subst.
        apply spDom_getExtMeths in H.
        apply specializeMod_dom_indexed in H; auto; dest.
        apply withIndex_index_eq in H; dest; lia.
      + unfold compLabelMaps.
        rewrite IHn; clear IHn; auto.
        unfold compLabelMaps.
        destruct (dropN ds n s v); auto.
        destruct (dropI ds u s s0); auto.
        destruct (dropI ds (S n) s s1); auto.
        unfold dropI; remember (string_eq _ _) as st; destruct st; auto.
        exfalso; apply string_eq_dec_eq in Heqst; subst.
        apply spDom_getExtMeths in H.
        apply duplicate_dom_indexed in H; auto; dest.
        apply withIndex_index_eq in H; dest; lia.
  Qed.

  Lemma duplicate_traceRefines_drop:
    forall n,
      (forall i, (m1 i) <<=[dropP ds] (m2 i)) ->
      (duplicate m1 n <<=[dropN ds n] duplicate m2 n).
  Proof.
    induction n; simpl; intros.
    - apply specializeMod_traceRefines_drop; auto.
    - apply traceRefines_modular_noninteracting_p; auto.
      + apply specializeMod_ModEquiv; auto.
      + apply specializeMod_ModEquiv; auto.
      + apply duplicate_ModEquiv; auto.
      + apply duplicate_ModEquiv; auto.
      + apply duplicate_specializeMod_disj_regs; auto.
      + apply duplicate_specializeMod_disj_regs; auto.
      + pose proof (duplicate_validRegsModules m1 (S n) Hvr1); auto.
      + pose proof (duplicate_validRegsModules m2 (S n) Hvr2); auto.
      + apply duplicate_specializeMod_disj_defs; auto.
      + eapply DisjList_comm, DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply DisjList_comm, duplicate_specializeMod_disj_calls; auto.
      + eapply DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply duplicate_specializeMod_disj_calls; auto.
      + apply duplicate_specializeMod_disj_defs; auto.
      + eapply DisjList_comm, DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply DisjList_comm, duplicate_specializeMod_disj_calls; auto.
      + eapply DisjList_SubList.
        * apply getIntCalls_getCalls.
        * apply duplicate_specializeMod_disj_calls; auto.
      + split.
        * apply equivalentLabelMapElem_dropI_dropN; auto; lia.
        * apply equivalentLabelMapElem_dropN_dropI; auto; lia.
      + apply duplicate_noninteracting; auto.
      + apply duplicate_noninteracting; auto.
      + apply specializeMod_traceRefines_drop; auto.
  Qed.

End DuplicateTwoModules2.

Section DuplicateTwoModules3.
  Variables (m1 m2: nat -> Modules).
  Hypotheses (Hequiv1: forall iv ty, ModEquiv ty typeUT (m1 iv))
             (Hequiv2: forall iv ty, ModEquiv ty typeUT (m2 iv))
             (Hvr1: forall iv ty, ValidRegsModules ty (m1 iv))
             (Hvr2: forall iv ty, ValidRegsModules ty (m2 iv))
             (Hsp1: forall iv, Specializable (m1 iv))
             (Hsp2: forall iv, Specializable (m2 iv)).

  Lemma duplicate_regs_ConcatMod_1:
    forall n,
      SubList (getRegInits (duplicate (fun i => (m1 i) ++ (m2 i))%kami n))
              (getRegInits (duplicate m1 n ++ duplicate m2 n)%kami).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2, SubList_app_1, SubList_refl.
      + unfold SubList in *; intros.
        specialize (IHn e H).
        apply in_app_or in IHn; destruct IHn.
        * apply in_or_app; left; apply in_or_app; auto.
        * apply in_or_app; right; apply in_or_app; auto.
          Transparent specializeMod.
  Qed.

  Lemma duplicate_regs_ConcatMod_2:
    forall n,
      SubList (getRegInits (duplicate m1 n ++ duplicate m2 n)%kami)
              (getRegInits (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2; apply SubList_app_4 in IHn; auto.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * apply SubList_app_1, SubList_app_2, SubList_refl.
        * apply SubList_app_2; apply SubList_app_5 in IHn; auto.
          Transparent specializeMod.
  Qed.

  Corollary duplicate_regs_ConcatMod:
    forall n,
      EquivList (getRegInits (duplicate m1 n ++ duplicate m2 n)%kami)
                (getRegInits (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    intros; split.
    - apply duplicate_regs_ConcatMod_2.
    - apply duplicate_regs_ConcatMod_1.
  Qed.

  Lemma duplicate_regs_NoDup_2:
    (forall i, NoDup (namesOf (getRegInits (m1 i ++ m2 i)%kami))) ->
    forall n,
      NoDup (namesOf (getRegInits (duplicate m1 n ++ duplicate m2 n)%kami)).
  Proof.
    Opaque specializeMod.
    intros.
    pose proof H; apply duplicate_regs_NoDup with (n:= n) in H0.
    induction n; simpl; intros.
    - simpl in *; rewrite specializeMod_concatMod in H0; auto.
    - assert (NoDup (namesOf (getRegInits (duplicate (fun i => m1 i ++ m2 i)%kami n)))).
      { apply duplicate_regs_NoDup; auto.
        intros; apply specializable_concatMod; auto.
      }
      specialize (IHn H1); clear H1.
      unfold namesOf; repeat rewrite map_app.
      rewrite app_assoc.
      rewrite <-app_assoc with (l:= map (@attrName _)
                                        (getRegInits (specializeMod (m1 (S n)) (S n)))).
      rewrite <-app_assoc with (l:= map (@attrName _)
                                        (getRegInits (specializeMod (m1 (S n)) (S n)))).
      apply NoDup_app_comm_ext.
      rewrite app_assoc.
      rewrite app_assoc.
      rewrite <-app_assoc with (n:= map (@attrName _) (getRegInits (duplicate m2 n))).
      apply NoDup_DisjList.
      + specialize (H (S n)); apply specializeMod_regs_NoDup with (i:= S n) in H;
          [|apply specializable_concatMod; auto].
        rewrite specializeMod_concatMod in H; auto.
        rewrite <-map_app; auto.
      + rewrite <-map_app; auto.
      + do 2 rewrite <-map_app.
        pose proof (duplicate_regs_ConcatMod_2 n).
        apply SubList_map with (f:= @attrName _) in H1.
        eapply DisjList_comm, DisjList_SubList; eauto.
        pose proof (specializeMod_concatMod (Hvr1 (S n)) (Hvr2 (S n))
                                            (Hequiv1 (S n)) (Hequiv2 (S n)) (S n)
                                            (Hsp1 (S n)) (Hsp2 (S n))).
        change (getRegInits (specializeMod (m1 (S n)) (S n)) ++
                            getRegInits (specializeMod (m2 (S n)) (S n)))
        with (getRegInits (specializeMod (m1 (S n)) (S n) ++
                                         (specializeMod (m2 (S n)) (S n)))%kami).
        rewrite <-H2.
        apply DisjList_comm.
        change (m1 (S n) ++ m2 (S n))%kami with ((fun i => (m1 i ++ m2 i)%kami) (S n)).
        apply duplicate_specializeMod_disj_regs; auto.
        intros; apply specializable_concatMod; auto.
    - intros; apply specializable_concatMod; auto.
  Qed.

  Lemma duplicate_rules_ConcatMod_1:
    forall n,
      SubList (getRules (duplicate (fun i => m1 i ++ m2 i)%kami n))
              (getRules (duplicate m1 n ++ duplicate m2 n)%kami).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2, SubList_app_1, SubList_refl.
      + unfold SubList in *; intros.
        specialize (IHn e H).
        apply in_app_or in IHn; destruct IHn.
        * apply in_or_app; left; apply in_or_app; auto.
        * apply in_or_app; right; apply in_or_app; auto.
          Transparent specializeMod.
  Qed.

  Lemma duplicate_rules_ConcatMod_2:
    forall n,
      SubList (getRules (duplicate m1 n ++ duplicate m2 n)%kami)
              (getRules (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2; apply SubList_app_4 in IHn; auto.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * apply SubList_app_1, SubList_app_2, SubList_refl.
        * apply SubList_app_2; apply SubList_app_5 in IHn; auto.
          Transparent specializeMod.
  Qed.

  Corollary duplicate_rules_ConcatMod:
    forall n,
      EquivList (getRules (duplicate m1 n ++ duplicate m2 n)%kami)
                (getRules (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    intros; split.
    - apply duplicate_rules_ConcatMod_2.
    - apply duplicate_rules_ConcatMod_1.
  Qed.

  Lemma duplicate_defs_ConcatMod_1:
    forall n,
      SubList (getDefsBodies (duplicate (fun i => m1 i ++ m2 i)%kami n))
              (getDefsBodies (duplicate m1 n ++ duplicate m2 n)%kami).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2, SubList_app_1, SubList_refl.
      + unfold SubList in *; intros.
        specialize (IHn e H).
        apply in_app_or in IHn; destruct IHn.
        * apply in_or_app; left; apply in_or_app; auto.
        * apply in_or_app; right; apply in_or_app; auto.
          Transparent specializeMod.
  Qed.

  Lemma duplicate_defs_ConcatMod_2:
    forall n,
      SubList (getDefsBodies (duplicate m1 n ++ duplicate m2 n)%kami)
              (getDefsBodies (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    Opaque specializeMod.
    induction n; intros.
    - unfold duplicate.
      rewrite specializeMod_concatMod; auto.
      apply SubList_refl.
    - simpl in *; apply SubList_app_3.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * do 2 apply SubList_app_1; apply SubList_refl.
        * apply SubList_app_2; apply SubList_app_4 in IHn; auto.
      + rewrite specializeMod_concatMod; auto.
        simpl; apply SubList_app_3.
        * apply SubList_app_1, SubList_app_2, SubList_refl.
        * apply SubList_app_2; apply SubList_app_5 in IHn; auto.
          Transparent specializeMod.
  Qed.

  Lemma duplicate_defs_ConcatMod:
    forall n,
      EquivList (getDefsBodies (duplicate m1 n ++ duplicate m2 n)%kami)
                (getDefsBodies (duplicate (fun i => m1 i ++ m2 i)%kami n)).
  Proof.
    intros; split.
    - apply duplicate_defs_ConcatMod_2.
    - apply duplicate_defs_ConcatMod_1.
  Qed.

End DuplicateTwoModules3.

Section DuplicateTwoModules4.
  Variables (m1 m2: nat -> Modules).
  Hypotheses (Hsp1: forall iv, Specializable (m1 iv))
             (Hsp2: forall iv, Specializable (m2 iv))
             (Hequiv1: forall iv ty, ModEquiv ty typeUT (m1 iv))
             (Hequiv2: forall iv ty, ModEquiv ty typeUT (m2 iv))
             (Hvr1: forall iv ty, ValidRegsModules ty (m1 iv))
             (Hvr2: forall iv ty, ValidRegsModules ty (m2 iv))
             (HnoDup: forall iv, NoDup (namesOf (getRegInits (m1 iv ++ m2 iv)%kami))).

  Lemma duplicate_concatMod_comm_1:
    forall n,
      duplicate (fun i => m1 i ++ m2 i)%kami n <<== ((duplicate m1 n) ++ (duplicate m2 n))%kami.
  Proof.
    intros; rewrite idElementwiseId.
    apply traceRefines_same_module_structure.
    - apply duplicate_regs_NoDup; auto.
      intros; apply specializable_concatMod; auto.
    - apply duplicate_regs_NoDup_2; auto.
    - split.
      + apply duplicate_regs_ConcatMod_1; auto.
      + apply duplicate_regs_ConcatMod_2; auto.
    - split.
      + apply duplicate_rules_ConcatMod_1; auto.
      + apply duplicate_rules_ConcatMod_2; auto.
    - split.
      + apply duplicate_defs_ConcatMod_1; auto.
      + apply duplicate_defs_ConcatMod_2; auto.
  Qed.

  Lemma duplicate_concatMod_comm_2:
    forall n,
      ((duplicate m1 n) ++ (duplicate m2 n))%kami <<== duplicate (fun i => m1 i ++ m2 i)%kami n.
  Proof.
    intros; rewrite idElementwiseId.
    apply traceRefines_same_module_structure.
    - apply duplicate_regs_NoDup_2; auto.
    - apply duplicate_regs_NoDup; auto.
      intros; apply specializable_concatMod; auto.
    - split.
      + apply duplicate_regs_ConcatMod_2; auto.
      + apply duplicate_regs_ConcatMod_1; auto.
    - split.
      + apply duplicate_rules_ConcatMod_2; auto.
      + apply duplicate_rules_ConcatMod_1; auto.
    - split.
      + apply duplicate_defs_ConcatMod_2; auto.
      + apply duplicate_defs_ConcatMod_1; auto.
  Qed.

End DuplicateTwoModules4.

#[global] Hint Unfold specializeMod duplicate: ModuleDefs.