(*
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

Require Import Equivalence.
Require Import Morphisms.
Require Import Setoid.
Require Import EquivDec.
Require Import Program.
Require Import List.
Require Import Utils.
Require Import DataSystem.
Require Import NRA.
Require Import NRAExt.
Require Import NRAEq.
Require Import NRARewrite.
Require Import TNRA.
Require Import TNRAEq.
Require Import Program.

Section TNRARewrite.
  Local Open Scope nra_scope.

  (* An attempt at proving some of the relational algebra's
     TYPE-DEPENDENT algebraic equivalences. *)

  (* P1 ∧ P2 == P2 ∧ P1 *)

  Context {m:basic_model}.

  Lemma tand_comm {τc} {τin} (op1 op2 opl opr: τin ⇝ Bool ⊣ τc) :
    (`opl = `op2 ∧ `op1) ->
    (`opr = `op2 ∧ `op1) ->
    opl ≡τ opr.
  Proof.
    intros.
    apply nra_eq_impl_tnra_eq.
    rewrite H; rewrite H0.
    rewrite and_comm.
    reflexivity.
  Qed.

  Lemma tand_comm_arrow {τc} {τin} (op1 op2:nra) :
    m ⊢ₐ τin ↦ Bool ⊣ τc ⊧ (op1 ∧ op2) ⇒ (op2 ∧ op1).
  Proof.
    intros.
    split.
    - inversion H; clear H; try eauto; subst.
      inversion H3; clear H3; subst.
      eapply type_NRABinop; try eauto.
      eapply type_OpAnd; assumption.
    - intros; rewrite and_comm; qeauto.
  Qed.

  (* σ{P1}(σ{P2}(P3)) == σ{P2 ∧ P1}(P3)) *)

  Lemma tselect_and_aux (x: data) c τc τin τ (op op1 op2:nra) :
    op ▷ τin >=> (Coll τ) ⊣ τc ->
    op1 ▷ τ >=> Bool ⊣ τc ->
    op2 ▷ τ >=> Bool ⊣ τc ->
    bindings_type c τc ->
    x ▹ τin ->
    brand_relation_brands ⊢ (σ⟨ op1 ⟩(σ⟨ op2 ⟩(op))) @ₐ x  ⊣ c =
    brand_relation_brands ⊢ (σ⟨ op2 ∧ op1 ⟩(op)) @ₐ x ⊣ c.
  Proof.
    intros ? ? ? Hcenv; intros; simpl.
    assert (exists d, (brand_relation_brands ⊢ op@ₐx ⊣ c = Some d /\ (d ▹ (Coll τ))))
      by (apply (@typed_nra_yields_typed_data m τc τin); assumption).
    elim H3; clear H3; intros.
    elim H3; clear H3; intros.
    rewrite H3; clear H3; simpl.
    invcs H4.
    rtype_equalizer.
    subst.
    autorewrite with alg.
    apply lift_dcoll_inversion.
    induction dl; try reflexivity.
    simpl.
    assert (Forall (fun d : data => data_type d τ) dl)
      by (clear IHdl; rewrite Forall_forall in *; intros;
          simpl in *; intuition).
    specialize (IHdl H3); clear H3.
    rewrite <- IHdl; clear IHdl.
    rewrite Forall_forall in H6; simpl in H6.
    assert (data_type a τ)
      by intuition.
    assert (exists d, (brand_relation_brands ⊢ op2@ₐa ⊣ c = Some d /\ (d ▹ Bool)))
      by (apply (@typed_nra_yields_typed_data m τc τ); assumption).
    destruct H4 as [? [eqq dt]].
    rewrite eqq; clear eqq.
    dtype_inverter.
    unfold olift.
    destruct (       lift_filter
         (fun x' : data =>
          match brand_relation_brands ⊢ op2 @ₐ x' ⊣ c with
          | Some (dbool b0) => Some b0
          | _ => None
          end) dl).
    - destruct x1.
      + simpl.
        assert (exists d, (brand_relation_brands ⊢ op1@ₐa ⊣ c = Some d /\ (d ▹ Bool)))
          by (apply (@typed_nra_yields_typed_data m τc τ); assumption).
        destruct H4 as [? [eqq dt]].
        rewrite eqq; clear eqq.
        dtype_inverter.
        reflexivity.
      + assert (exists d, (brand_relation_brands ⊢ op1@ₐa ⊣ c = Some d /\ (d ▹ Bool)))
          by (apply (@typed_nra_yields_typed_data m τc τ); assumption).
        destruct H4 as [? [eqq dt]].
        rewrite eqq; clear eqq.
        dtype_inverter.
        destruct (lift_filter
     (fun x' : data =>
      match brand_relation_brands ⊢ op1 @ₐ x' ⊣ c with
      | Some (dbool b0) => Some b0
      | _ => None
      end) l); reflexivity.
    - destruct (brand_relation_brands ⊢ op1@ₐa ⊣ c); try reflexivity.
      destruct d; reflexivity.
  Qed.

  Lemma tselect_and {τc} {τin τ} (op opl opr: τin ⇝ (Coll τ) ⊣ τc) (op1 op2:τ ⇝ Bool ⊣ τc) :
    (`opl = σ⟨ `op1 ⟩(σ⟨ `op2 ⟩(`op))) ->
    (`opr = σ⟨ `op2 ∧ `op1 ⟩(`op)) ->
    (opl ≡τ opr).
  Proof.
    unfold tnra_eq; intros.
    rewrite H; rewrite H0.
    rewrite (tselect_and_aux x c τc τin τ).
    reflexivity.
    apply (proj2_sig op).
    apply (proj2_sig op1).
    apply (proj2_sig op2).
    assumption.
    assumption.
  Qed.

  (* σ⟨ P1 ⟩(σ⟨ P2 ⟩(P3)) == σ⟨ P2 ⟩(σ⟨ P1 ⟩(P3)) *)

  (* This is the first rewrite done at algebra level, using nra_eq. *)
  Lemma tselect_comm_nra {τc} {τin τ} (op1 op2:τ ⇝ Bool ⊣ τc) (op opl opr: τin ⇝ (Coll τ) ⊣ τc) :
    (`opl = σ⟨ `op1 ⟩(σ⟨ `op2 ⟩(`op))) ->
    (`opr = σ⟨ `op2 ⟩(σ⟨ `op1 ⟩(`op))) ->
    opl ≡τ opr.
  Proof.
    intros.
    unfold tnra_eq; intros.
    rewrite H; rewrite H0.
    rewrite (tselect_and_aux x c τc τin τ); try assumption.
    rewrite (tselect_and_aux x c τc τin τ); try assumption.
    generalize and_comm; intros.
    assert ((σ⟨ ` op2 ∧ ` op1 ⟩( ` op)) ≡ₐ (σ⟨ ` op1 ∧ ` op2 ⟩( ` op))).
    rewrite (H1 (`op1) (`op2)).
    reflexivity.
    rewrite H2 by qeauto.
    reflexivity.
    apply (proj2_sig op).
    apply (proj2_sig op2).
    apply (proj2_sig op1).
    apply (proj2_sig op).
    apply (proj2_sig op1).
    apply (proj2_sig op2).
  Qed.

  Lemma tselect_comm {τc} {τin τ} c x (op: τin ⇝ (Coll τ) ⊣ τc) (op1 op2:τ ⇝ Bool ⊣ τc) :
    bindings_type c τc ->
    x ▹ τin ->
    (brand_relation_brands ⊢ σ⟨ `op1 ⟩(σ⟨ `op2 ⟩(`op)) @ₐ x ⊣ c) = (brand_relation_brands ⊢ σ⟨ `op2 ⟩(σ⟨ `op1 ⟩(`op)) @ₐ x ⊣ c).
  Proof.
    generalize (@tselect_comm_nra τc τin); intros.
    unfold tnra_eq in H.
    specialize (H τ op1 op2 op).
    assert (σ⟨ `op1 ⟩( σ⟨ `op2 ⟩( ` op)) ▷ τin >=> Coll τ ⊣ τc).
    apply type_NRASelect.
    apply (proj2_sig op1).
    apply type_NRASelect.
    apply (proj2_sig op2).
    apply (proj2_sig op).
    assert (σ⟨ `op2 ⟩( σ⟨ `op1 ⟩( ` op)) ▷ τin >=> Coll τ ⊣ τc).
    apply type_NRASelect.
    apply (proj2_sig op2).
    apply type_NRASelect.
    apply (proj2_sig op1).
    apply (proj2_sig op).
    assert (exists opl:τin ⇝ Coll τ ⊣ τc, `opl = σ⟨ `op1 ⟩( σ⟨ `op2 ⟩(`op))).
    revert H2.
    generalize (σ⟨ `op1 ⟩( σ⟨ `op2 ⟩( `op))); intros.
    exists (exist (fun op => nra_type τc op τin (Coll τ)) n H2).
    reflexivity.
    assert (exists opr:τin ⇝ Coll τ ⊣ τc, `opr = σ⟨ `op2 ⟩( σ⟨ `op1 ⟩(`op))).
    revert H3.
    generalize (σ⟨ `op2 ⟩( σ⟨ `op1 ⟩(`op))); intros.
    exists (exist (fun op => nra_type τc op τin (Coll τ)) n H3).
    reflexivity.
    elim H4; elim H5; intros.
    rewrite <- H6.
    rewrite <- H7.
    apply (H x1 x0).
    assumption.
    assumption.
    assumption.
    assumption.
  Qed.

  (* σ⟨P⟩(P1 − P2) == σ⟨P⟩(P1) − σ⟨P⟩(P2) *)

  Definition tunbox_bool (y:{ x:data | x ▹ Bool }) : bool.
  Proof.
    elim y; clear y.
    intros.
    destruct x; try (assert False by (inversion p; contradiction) ; contradiction).
    exact b.
  Defined.

  Definition typed_nra_total_bool {τc} {τ} c (op:τ ⇝ Bool ⊣ τc):
    bindings_type c τc ->
    {x:data|(x ▹ τ)} -> bool.
  Proof.
    intros.
    apply tunbox_bool.
    apply (@typed_nra_total m τc τ Bool (`op) (proj2_sig op) c (`H0) H).
    elim H0; intros.
    exact p.
  Defined.

  Lemma typed_nra_total_bool_consistent {τc} {τ} c (op:τ ⇝ Bool ⊣ τc) (d: {x:data|(x ▹ τ)}) (Hcenv:bindings_type c τc) :
    match (brand_relation_brands ⊢ `op@ₐ`d ⊣ c) with
      | Some (dbool b) => Some b
      | _ => None
    end = Some (typed_nra_total_bool c op Hcenv d).
  Proof.
    unfold typed_nra_total_bool.
    unfold typed_nra_total.
    generalize (typed_nra_yields_typed_data c (`d) (`op) Hcenv (sig_ind (fun H : {x : data | x ▹ τ} => ` H ▹ τ)
                 (fun (x : data) (p : x ▹ τ) => p) d)
                                            (proj2_sig op)); intros.
    destruct e; simpl.
    destruct a; simpl.
    rewrite e; clear e.
    destruct x; try (assert False by (inversion d0; contradiction) ; contradiction).
    reflexivity.
  Qed.

  Lemma typed_nra_total_bool_consistent2 {τc} {τ} c (op:τ ⇝ Bool ⊣ τc) (x:data) (pf:(x ▹ τ)) (Hcenv:bindings_type c τc) :
    match (brand_relation_brands ⊢ `op@ₐx ⊣ c) with
      | Some (dbool b) => Some b
      | _ => None
    end = Some (typed_nra_total_bool c op Hcenv (exist _ x pf)).
  Proof.
    apply (typed_nra_total_bool_consistent c op (exist _ x pf)).
  Qed.

  Lemma typed_lifted_predicate {τc} {τ} (op:τ ⇝ Bool ⊣ τc) c (d:data):
    bindings_type c τc ->
    data_type d τ ->
    exists b' : bool,
      (fun x' : data =>
         match brand_relation_brands ⊢ (`op)@ₐ x' ⊣ c with
           | Some (dbool b) => Some b
           | _ => None
         end) d = Some b'.
  Proof.
    intros.
    exists (typed_nra_total_bool c op H (exist _ d H0)).
    apply typed_nra_total_bool_consistent2.
  Qed.

  Lemma lift_filter_remove_one_false (l:list data) (f:data -> option bool) (a:data) :
    f a = Some false ->
    (lift_filter f (remove_one a l)) = lift_filter f l.
  Proof.
    intros.
    induction l; simpl; try reflexivity.
    destruct (equiv_dec a a0); simpl.
    - rewrite e in *; clear e.
      rewrite H; simpl; clear H.
      destruct (lift_filter f l); reflexivity.
    - destruct (f a0); try reflexivity.
      rewrite IHl; reflexivity.
  Qed.

  Lemma lift_filter_remove_one {τ} (l:list data) (f:data -> option bool) (a:data) :
    Forall (fun d : data => data_type d τ) l ->
    data_type a τ ->
    (forall d : data, data_type d τ -> exists b' : bool, f d = Some b') ->
    (lift_filter f (remove_one a l)) = lift (remove_one a) (lift_filter f l).
  Proof.
    intros.
    induction l; simpl; try reflexivity.
    destruct (equiv_dec a a0); intros; simpl.
    - rewrite e in *; clear e.
      case_eq (f a0); try reflexivity; simpl; intros.
      + inversion H; clear H. specialize (IHl H6).
        case_eq b; simpl; intros.
        * revert IHl.
          destruct (lift_filter f l); try reflexivity; intros; simpl.
          destruct (equiv_dec a0 a0); try congruence.
        * rewrite H in *; clear H.
          rewrite lift_filter_remove_one_false in IHl; try assumption.
          rewrite IHl at 1.
          destruct (lift_filter f l); reflexivity.
      + inversion H; clear H; elim (H1 a0 H0); intros; congruence.
    - destruct (f a0); try reflexivity.
      inversion H; clear H. specialize (IHl H5); clear H5 H2 H3.
      rewrite IHl.
      destruct (lift_filter f l); try reflexivity.
      destruct b; try reflexivity.
      simpl.
      destruct (equiv_dec a a0); congruence.
  Qed.

  Lemma remove_still_well_typed {τ} (l:list data) (a:data) :
    Forall (fun d : data => data_type d τ) l ->
    Forall (fun d : data => data_type d τ) (remove_one a l).
  Proof.
    intros.
    induction l.
    - simpl; apply Forall_nil.
    - simpl in *.
      inversion H; clear H.
      destruct (equiv_dec a a0).
      + assumption.
      + apply Forall_cons; auto.
  Qed.

  Lemma lift_filter_over_bminus {τ} (l1 l2 : list data) (f:data -> option bool):
    Forall (fun d : data => data_type d τ) l1 ->
    Forall (fun d : data => data_type d τ) l2 ->
    Forall (fun d : data => data_type d τ) (bminus l1 l2) ->
    (forall d : data, data_type d τ -> exists b' : bool, f d = Some b') ->
    lift dcoll (lift_filter f (bminus l1 l2)) =
    match lift dcoll (lift_filter f l2) with
      | Some d2 =>
        match lift dcoll (lift_filter f l1) with
          | Some d1 => rondcoll2 bminus d1 d2
          | None => None
        end
      | None => None
    end.
  Proof.
    intros.
    revert l2 H0 H1.
    induction l1; simpl; try reflexivity; intros.
    - destruct (lift_filter f l2); reflexivity.
    - inversion H; clear H x H3 H4.
      specialize (IHl1 H6); clear H6.
      case_eq (f a).
      + intros b eqf; simpl.
        case_eq b; intros; rewrite H in *; clear H.
        (* true *)
        * rewrite IHl1; simpl; try assumption.
          case_eq (lift_filter f l1); intros; try reflexivity; simpl.
          unfold lift; simpl.
          rewrite (lift_filter_remove_one l2 f a H0 H5 H2); simpl.
          destruct (lift_filter f l2); try reflexivity.
          rewrite (lift_filter_remove_one l2 f a H0 H5 H2); simpl.
          destruct (lift_filter f l2); try reflexivity.
          apply remove_still_well_typed; assumption.
        (* false *)
        * rewrite IHl1; simpl; try assumption.
          destruct (lift_filter f l1); try reflexivity; simpl.
          rewrite (lift_filter_remove_one_false); simpl.
          destruct (lift_filter f l2); try reflexivity.
          assumption.
          rewrite (lift_filter_remove_one_false); simpl.
          destruct (lift_filter f l2); try reflexivity.
          assumption.
          apply remove_still_well_typed; assumption.
      + intros.
        elim (H2 a); try assumption; intros.
        congruence.
  Qed.

  Lemma minus_select_distr {τc} {τin τ} (op:τ ⇝ Bool ⊣ τc) (op1 op2 opl opr: τin ⇝ (Coll τ) ⊣ τc) :
    (`opl = σ⟨`op⟩(`op1 − `op2)) ->
    (`opr = σ⟨`op⟩(`op1) − σ⟨`op⟩(`op2)) ->
    opl ≡τ opr.
  Proof.
    unfold tnra_eq.
    intros ? ? x c ? Hcenv.
    rewrite H; rewrite H0; clear H H0 opl opr; simpl.
    assert (exists d1, (brand_relation_brands ⊢ `op1@ₐx ⊣ c = Some d1 /\ (d1 ▹ (Coll τ))))
      by (apply (@typed_nra_yields_typed_data m τc τin); [assumption|assumption|apply (proj2_sig op1)]).
    assert (exists d2, (brand_relation_brands ⊢ `op2@ₐx ⊣ c = Some d2 /\ (d2 ▹ (Coll τ))))
      by (apply (@typed_nra_yields_typed_data m τc τin); [assumption|assumption|apply (proj2_sig op2)]).
    elim H; elim H0; clear H H0; intros.
    elim H; elim H0; clear H H0; intros.
    rewrite H; rewrite H1; clear H H1.
    simpl.
    invcs H0; invcs H2.
    rtype_equalizer.
    subst.
    simpl.
    assert (Forall (fun d : data => data_type d τ) (bminus dl0 dl))
      by (apply bminus_Forall; assumption).
    assert (exists f, (forall d : data,
                         data_type d τ ->
                         exists b' : bool,
                           f d = Some b') /\ f = ((fun x' : data =>
         match brand_relation_brands ⊢ (` op) @ₐ x' ⊣ c with
         | Some (dbool b) => Some b
         | _ => None
         end))).
    exists  ((fun x' : data =>
         match brand_relation_brands ⊢ (` op) @ₐ x' ⊣ c with
         | Some (dbool b) => Some b
         | _ => None
         end));
      split. intros. apply typed_lifted_predicate; try assumption. reflexivity.
    destruct H0 as [? [eqq dt]].
    revert dt.
    generalize ((fun x' : data =>
       match brand_relation_brands ⊢ (` op) @ₐ x' ⊣ c with
       | Some (dbool b) => Some b
       | _ => None
       end)); intros.
    subst.
    unfold olift2.
    eapply lift_filter_over_bminus; eauto.
  Qed.

End TNRARewrite.


Require Import Bool List String PeanoNat.
Require Import Common IndexSupport FMap.
Require Import Syntax Semantics SemFacts StepM Serial Invariant.

Require Import Lia.
Require Import Program.Equality.

Set Implicit Arguments.

Local Open Scope list.
Local Open Scope fmap.

Section MsgParam.
  Context `{dv: DecValue}.

  Lemma atomic_emptyILabel_not_in:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      ~ In RlblEmpty hst.
  Proof.
    induction 1; simpl; intros.
    - intro Hx; destruct Hx; [discriminate|auto].
    - intro Hx; destruct Hx; subst; [discriminate|auto].
  Qed.

  Lemma atomic_iLblIn_not_in:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      forall msg, ~ In (RlblIns [msg]) hst.
  Proof.
    induction 1; simpl; intros; [auto|];
      try (intro Hx; destruct Hx;
           [discriminate|firstorder]).
  Qed.

  Fixpoint insOfA (hst: History) :=
    match hst with
    | nil => nil
    | lbl :: hst' =>
      match lbl with
      | RlblInt _ _ ins _ => insOfA hst' ++ ins
      | _ => nil
      end
    end.

  Fixpoint outsOfA (hst: History) :=
    match hst with
    | nil => nil
    | lbl :: hst' =>
      match lbl with
      | RlblInt _ _ _ outs => outsOfA hst' ++ outs
      | _ => nil
      end
    end.

  Lemma atomic_lastOIdxOf:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      exists loidx,
        lastOIdxOf hst = Some loidx.
  Proof.
    induction 1; simpl; intros; eauto.
  Qed.

  Lemma atomic_ins:
    forall (hst: History) inits ins outs eouts,
      Atomic inits ins hst outs eouts ->
      ins = insOfA hst.
  Proof.
    induction 1; simpl; intros; subst; reflexivity.
  Qed.

  Lemma atomic_outs:
    forall (hst: History) inits ins outs eouts,
      Atomic inits ins hst outs eouts ->
      outs = outsOfA hst.
  Proof.
    induction 1; simpl; intros; subst; reflexivity.
  Qed.

  Lemma atomic_unique:
    forall (hst: History) inits1 ins1 outs1 eouts1,
      Atomic inits1 ins1 hst outs1 eouts1 ->
      forall inits2 ins2 outs2 eouts2,
        Atomic inits2 ins2 hst outs2 eouts2 ->
        inits1 = inits2 /\ ins1 = ins2 /\
        outs1 = outs2 /\ eouts1 = eouts2.
  Proof.
    induction 1; simpl; intros; subst.
    - inv H; [auto|inv H5].
    - inv H5; [inv H|].
      specialize (IHAtomic _ _ _ _ H8).
      dest; subst; auto.
  Qed.

  Lemma atomic_messages_spec_ValidDeqs:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      forall `{oifc: OStateIfc} (sys: System) st1 st2,
        steps step_m sys st1 hst st2 ->
        st_msgs st2 = deqMsgs (idsOf ins) (enqMsgs outs (st_msgs st1)) /\
        ValidDeqs (enqMsgs outs (st_msgs st1)) (idsOf ins).
  Proof.
    induction 1; simpl; intros; subst.
    - inv H; inv H3; inv H5; simpl; split.
      + apply enqMsgs_deqMsgs_comm; auto.
      + apply ValidDeqs_enqMsgs.
        destruct H10.
        apply FirstMPI_Forall_NoDup_ValidDeqs; auto.

    - inv H5.
      specialize (IHAtomic _ _ _ _ H6); dest.
      inv H8; simpl in *; subst.
      repeat rewrite idsOf_app, deqMsgs_app, enqMsgs_app.
      split.
      + rewrite enqMsgs_deqMsgs_comm with (minds1:= idsOf rins) by assumption.
        rewrite enqMsgs_deqMsgs_ValidDeqs_comm
          with (minds:= idsOf ins) (nmsgs:= routs) by assumption.
        reflexivity.
      + apply ValidDeqs_app.
        * apply ValidDeqs_enqMsgs; auto.
        * rewrite <-enqMsgs_deqMsgs_ValidDeqs_comm
            with (minds:= idsOf ins) (nmsgs:= routs) by assumption.
          destruct H16.
          apply ValidDeqs_enqMsgs; auto.
          apply FirstMPI_Forall_NoDup_ValidDeqs; auto.
  Qed.

  Corollary atomic_messages_spec:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      forall `{oifc: OStateIfc} (sys: System) st1 st2,
        steps step_m sys st1 hst st2 ->
        st_msgs st2 = deqMsgs (idsOf ins) (enqMsgs outs (st_msgs st1)).
  Proof.
    intros; eapply atomic_messages_spec_ValidDeqs; eauto.
  Qed.

  Lemma atomic_messages_inits_valid:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      forall `{oifc: OStateIfc} (sys: System) st1 st2,
        steps step_m sys st1 hst st2 ->
        ValidMsgsIn sys inits.
  Proof.
    induction 1; simpl; intros; subst.
    - inv_steps; inv_step; assumption.
    - inv_steps; eauto.
  Qed.

  Lemma atomic_messages_ins_outs:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      EquivList (inits ++ outs) (ins ++ eouts).
  Proof.
    induction 1; simpl; intros; subst;
      [apply EquivList_refl|].

    destruct IHAtomic; split.
    - repeat rewrite app_assoc.
      apply SubList_app_6; [|apply SubList_refl].
      eapply SubList_trans; [eassumption|].
      rewrite <-app_assoc.
      apply SubList_app_6; [apply SubList_refl|].
      apply removeL_SubList_3.
    - repeat rewrite app_assoc.
      apply SubList_app_6; [|apply SubList_refl].
      eapply SubList_trans; [|eassumption].
      rewrite <-app_assoc.
      apply SubList_app_6; [apply SubList_refl|].
      apply SubList_app_3; [assumption|].
      apply removeL_SubList_2.
  Qed.

  Lemma atomic_behavior_nil:
    forall (hst: History) inits ins outs eouts,
      Atomic inits ins hst outs eouts ->
      behaviorOf hst = nil.
  Proof.
    induction 1; simpl; intros; auto.
  Qed.

  Lemma atomic_singleton:
    forall oidx ridx ins outs,
      Atomic ins ins [RlblInt oidx ridx ins outs] outs outs.
  Proof.
    intros; constructor.
  Qed.

  Lemma extAtomic_unique:
    forall `{oifc: OStateIfc} (sys: System) inits1 hst eouts1,
      ExtAtomic sys inits1 hst eouts1 ->
      forall inits2 eouts2,
        ExtAtomic sys inits2 hst eouts2 ->
        inits1 = inits2 /\ eouts1 = eouts2.
  Proof.
    intros.
    inv H; inv H0.
    pose proof (atomic_unique H2 H3); dest; subst; auto.
  Qed.

  Lemma extAtomic_preserved:
    forall `{oifc: OStateIfc} (impl1: System) inits hst eouts,
      ExtAtomic impl1 inits hst eouts ->
      forall (impl2: System),
        sys_merqs impl1 = sys_merqs impl2 ->
        ExtAtomic impl2 inits hst eouts.
  Proof.
    intros.
    inv H.
    econstructor; eauto.
    rewrite <-H0; assumption.
  Qed.

  Lemma atomic_split_each:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      Forall AtomicEx (lift_each hst).
  Proof.
    induction 1; simpl; intros; [repeat econstructor|].
    repeat econstructor.
    assumption.
  Qed.

  Lemma atomicEx_split_each:
    forall hst,
      AtomicEx hst ->
      Forall AtomicEx (lift_each hst).
  Proof.
    unfold AtomicEx; intros; dest.
    eapply atomic_split_each; eauto.
  Qed.

  Definition InternalLbl (lbl: RLabel) :=
    match lbl with
    | RlblInt _ _ _ _ => True
    | _ => False
    end.

  Definition InsLbl (lbl: RLabel) :=
    match lbl with
    | RlblIns _ => True
    | _ => False
    end.

  Definition OutsLbl (lbl: RLabel) :=
    match lbl with
    | RlblOuts _ => True
    | _ => False
    end.

  Definition NonInsLbl (lbl: RLabel) :=
    match lbl with
    | RlblIns _ => False
    | _ => True
    end.

  Definition NonOutsLbl (lbl: RLabel) :=
    match lbl with
    | RlblOuts _ => False
    | _ => True
    end.

  Definition HistoryP (P: RLabel -> Prop) (hst: History) :=
    Forall (fun lbl => P lbl) hst.

  Definition InternalHistory := HistoryP InternalLbl.
  Definition InsHistory := HistoryP InsLbl.
  Definition OutsHistory := HistoryP OutsLbl.
  Definition NonInsHistory := HistoryP NonInsLbl.
  Definition NonOutsHistory := HistoryP NonOutsLbl.

  Lemma atomic_internal_history:
    forall inits ins hst outs eouts,
      Atomic inits ins hst outs eouts ->
      InternalHistory hst.
  Proof.
    induction 1; simpl; intros.
    - repeat constructor.
    - repeat constructor; auto.
  Qed.

  Lemma atomicEx_internal_history:
    forall hst,
      AtomicEx hst ->
      InternalHistory hst.
  Proof.
    unfold AtomicEx; intros; dest.
    eapply atomic_internal_history; eauto.
  Qed.

  Lemma sequential_nil:
    forall `{oifc: OStateIfc} (sys: System), Sequential sys nil nil.
  Proof.
    intros; hnf; intros.
    split.
    - constructor.
    - reflexivity.
  Qed.

  Lemma sequential_cons:
    forall `{oifc: OStateIfc} (sys: System) ll trss,
      Sequential sys ll trss ->
      forall trs,
        Transactional sys trs ->
        Sequential sys (trs ++ ll) (trs :: trss).
  Proof.
    intros.
    inv H.
    constructor; auto.
  Qed.

  Lemma sequential_silent:
    forall `{oifc: OStateIfc} (sys: System) ll trss,
      Sequential sys ll trss ->
      Sequential sys (RlblEmpty :: ll) ([RlblEmpty] :: trss).
  Proof.
    intros.
    hnf; hnf in H; dest.
    split.
    - constructor; [|eassumption].
      constructor.
    - subst; reflexivity.
  Qed.

  Lemma sequential_msg_ins:
    forall `{oifc: OStateIfc} (sys: System) ll trss eins,
      Sequential sys ll trss ->
      Sequential sys (RlblIns eins :: ll) ([RlblIns eins] :: trss).
  Proof.
    intros.
    hnf; hnf in H; dest.
    split.
    - constructor; [|eassumption].
      eapply TrsIns; reflexivity.
    - subst; reflexivity.
  Qed.

  Lemma sequential_msg_outs:
    forall `{oifc: OStateIfc} (sys: System) ll trss eouts,
      Sequential sys ll trss ->
      Sequential sys (RlblOuts eouts :: ll) ([RlblOuts eouts] :: trss).
  Proof.
    intros.
    hnf; hnf in H; dest.
    split.
    - constructor; [|eassumption].
      eapply TrsOuts; reflexivity.
    - subst; reflexivity.
  Qed.

  Lemma sequential_insHistory:
    forall `{oifc: OStateIfc} (sys: System) ins,
      InsHistory ins ->
      Sequential sys ins (lift_each ins).
  Proof.
    induction ins; simpl; intros; [constructor; auto|].
    inv H; destruct a; try (intuition; fail).
    specialize (IHins H3); destruct IHins.
    split.
    - constructor; auto.
      eapply TrsIns; eauto.
    - simpl; rewrite H0 at 1; reflexivity.
  Qed.

  Lemma sequential_outsHistory:
    forall `{oifc: OStateIfc} (sys: System) outs,
      OutsHistory outs ->
      Sequential sys outs (lift_each outs).
  Proof.
    induction outs; simpl; intros; [constructor; auto|].
    inv H; destruct a; try (intuition; fail).
    specialize (IHouts H3); destruct IHouts.
    split.
    - constructor; auto.
      eapply TrsOuts; eauto.
    - simpl; rewrite H0 at 1; reflexivity.
  Qed.

  Lemma ssequential_insHistory:
    forall `{oifc: OStateIfc} (sys: System) ins,
      InsHistory ins ->
      SSequential sys (lift_each ins) 0.
  Proof.
    induction ins; simpl; intros.
    - apply SSeqNil.
    - inv H; destruct a; try (intuition; fail).
      specialize (IHins H3).
      econstructor; eauto.
      eapply STrsIns; reflexivity.
  Qed.

  Lemma ssequential_outsHistory:
    forall `{oifc: OStateIfc} (sys: System) outs,
      OutsHistory outs ->
      SSequential sys (lift_each outs) 0.
  Proof.
    induction outs; simpl; intros.
    - apply SSeqNil.
    - inv H; destruct a; try (intuition; fail).
      specialize (IHouts H3).
      econstructor; eauto.
      eapply STrsOuts; reflexivity.
  Qed.

  Lemma sequential_app:
    forall `{oifc: OStateIfc} (sys: System) ll1 trss1 ll2 trss2,
      Sequential sys ll1 trss1 ->
      Sequential sys ll2 trss2 ->
      Sequential sys (ll1 ++ ll2) (trss1 ++ trss2).
  Proof.
    unfold Sequential; intros.
    destruct H, H0; subst.
    split.
    - apply Forall_app; auto.
    - apply eq_sym, concat_app.
  Qed.

  Lemma sequential_serializable:
    forall `{oifc: OStateIfc} (sys: System) hst trss st,
      steps step_m sys (initsOf sys) hst st ->
      Sequential sys hst trss ->
      Serializable sys st.
  Proof.
    intros; red; intros.
    eexists; split; eauto.
  Qed.

  Lemma stransactional_default:
    forall `{oifc: OStateIfc} (sys: System) lbl,
      exists n,
        STransactional sys [lbl] n.
  Proof.
    destruct lbl; intros; eexists.
    - eapply STrsSlt.
    - eapply STrsIns; eauto.
    - instantiate
        (1:= if subList_dec idx_dec (idsOf mins) sys.(sys_merqs)
             then _ else _).
      destruct (subList_dec idx_dec (idsOf mins) sys.(sys_merqs)).
      + eapply STrsExtAtomic.
        econstructor; eauto.
        econstructor.
      + eapply STrsIntAtomic.
        econstructor; eauto.
        econstructor.
    - eapply STrsOuts; eauto.
  Qed.

  Lemma ssequential_default:
    forall `{oifc: OStateIfc} (sys: System) hst,
    exists n trss,
      SSequential sys trss n /\ hst = List.concat trss.
  Proof.
    induction hst as [|l hst]; simpl; intros; [repeat econstructor; eauto|].
    destruct IHhst as [n [trss ?]]; dest; subst.
    pose proof (stransactional_default sys l).
    destruct H0 as [ln ?].
    exists (ln + n), ([l] :: trss).
    split.
    - econstructor; eauto.
    - reflexivity.
  Qed.

  Lemma ssequential_add:
    forall `{oifc: OStateIfc} (sys: System) ll1 ll2 n,
      SSequential sys (ll1 ++ ll2) n ->
      forall trs tn,
        STransactional sys trs tn ->
        SSequential sys (ll1 ++ trs :: ll2) (tn + n).
  Proof.
    induction ll1; simpl; intros; [econstructor; eauto|].
    inv H; inv H3.
    specialize (IHll1 _ _ H1 _ _ H0).
    econstructor.
    - exact IHll1.
    - exact H2.
    - reflexivity.
    - lia.
  Qed.

  Lemma ssequential_app:
    forall `{oifc: OStateIfc} (sys: System) ll1 n1 ll2 n2,
      SSequential sys ll1 n1 ->
      SSequential sys ll2 n2 ->
      SSequential sys (ll1 ++ ll2) (n1 + n2).
  Proof.
    induction 1; simpl; intros; subst; simpl; auto.
    econstructor.
    - exact (IHSSequential H3).
    - eassumption.
    - reflexivity.
    - lia.
  Qed.

  Lemma ssequential_app_inv:
    forall `{oifc: OStateIfc} (sys: System) ll1 ll2 n,
      SSequential sys (ll1 ++ ll2) n ->
      exists n1 n2,
        SSequential sys ll1 n1 /\
        SSequential sys ll2 n2 /\
        n = n1 + n2.
  Proof.
    induction ll1; simpl; intros.
    - exists 0, n; repeat split; [constructor|assumption].
    - inv H; inv H2.
      specialize (IHll1 _ _ H0).
      destruct IHll1 as [n1 [n2 ?]]; dest; subst.
      exists (tn + n1), n2; repeat split.
      + econstructor.
        * exact H.
        * exact H1.
        * reflexivity.
        * reflexivity.
      + assumption.
      + lia.
  Qed.

  Lemma ssequential_distr_inv:
    forall `{oifc: OStateIfc} (sys: System) ll ll1 ll2,
      Distribution ll ll1 ll2 ->
      forall n,
        SSequential sys ll n ->
        exists n1 n2,
          SSequential sys ll1 n1 /\
          SSequential sys ll2 n2 /\
          n = n1 + n2.
  Proof.
    induction 1; simpl; intros.
    - inv H; try discriminate.
      exists 0, 0; repeat split; constructor.
    - inv H0; inv H3.
      specialize (IHDistribution _ H1).
      destruct IHDistribution as [n1 [n2 ?]]; dest; subst.
      apply ssequential_app_inv in H0.
      destruct H0 as [n11 [n12 ?]]; dest; subst.
      exists (n11 + (tn + n12)), n2; repeat split.
      + apply ssequential_app; auto.
        econstructor; try reflexivity; auto.
      + assumption.
      + lia.
    - inv H0; inv H3.
      specialize (IHDistribution _ H1).
      destruct IHDistribution as [n1 [n2 ?]]; dest; subst.
      apply ssequential_app_inv in H3.
      destruct H3 as [n21 [n22 ?]]; dest; subst.
      exists n1, (n21 + (tn + n22)); repeat split.
      + assumption.
      + apply ssequential_app; auto.
        econstructor; try reflexivity; auto.
      + lia.
  Qed.

  Lemma intAtomic_stransactional_split_each:
    forall `{oifc: OStateIfc} (sys: System) inits ins trs outs eouts,
      ~ SubList (idsOf inits) (sys_merqs sys) ->
      Atomic inits ins trs outs eouts ->
      exists sn,
        SSequential sys (lift_each trs) sn /\
        sn <= List.length trs.
  Proof.
    induction 2; simpl; intros; subst.
    - eexists; split.
      + econstructor; try reflexivity.
        * eapply SSeqNil.
        * eapply STrsIntAtomic.
          econstructor; eauto.
          econstructor.
      + simpl; lia.
    - specialize (IHAtomic H).
      destruct IHAtomic as [sn [? ?]].
      destruct (subList_dec idx_dec (idsOf rins) (sys_merqs sys)).
      + eexists; split.
        * econstructor; try reflexivity.
          { eassumption. }
          { eapply STrsExtAtomic.
            econstructor; eauto.
            econstructor.
          }
        * lia.
      + eexists; split.
        * econstructor; try reflexivity.
          { eassumption. }
          { eapply STrsIntAtomic.
            econstructor; eauto.
            econstructor.
          }
        * simpl; lia.
  Qed.

  Corollary internal_stransactional_split_each:
    forall `{oifc: OStateIfc} (sys: System) inits ins trs outs eouts tn,
      ~ SubList (idsOf inits) (sys_merqs sys) ->
      Atomic inits ins trs outs eouts ->
      STransactional sys trs tn ->
      exists sn,
        SSequential sys (lift_each trs) sn /\
        sn <= tn.
  Proof.
    intros.
    inv H1; try (inv H0; fail).
    - eapply intAtomic_stransactional_split_each; eauto.
    - exfalso; inv H2.
      pose proof (atomic_unique H0 H3); dest; subst.
      auto.
  Qed.

End MsgParam.

Lemma atomic_Transactional_ExtAtomic:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) trs,
    AtomicEx trs ->
    Transactional sys trs ->
    exists einits eouts,
      ExtAtomic sys einits trs eouts.
Proof.
  intros.
  destruct H as [inits [ins [outs [eouts ?]]]].
  inv H0; try (inv H; fail).
  eauto.
Qed.

Lemma sequential_transactional_Forall:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) st1 trss st2,
    steps step_m sys st1 (List.concat trss) st2 ->
    Forall (Transactional sys) trss ->
    Sequential sys (List.concat trss) trss.
Proof.
  induction trss; simpl; intros; [repeat constructor|].
  eapply steps_split in H; [|reflexivity].
  destruct H as [sti [? ?]].
  inv H0.
  eapply sequential_cons; eauto.
Qed.

Lemma atomic_messages_eouts_count_le:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      forall idm,
        count_occ (id_dec msg_dec) eouts idm <=
        countMsg msg_dec idm st2.(st_msgs).
Proof.
  induction 1; simpl; intros; subst.
  - inv_steps; inv_step; simpl.
    rewrite countMsg_enqMsgs; lia.
  - inv_steps; inv_step; simpl.
    rewrite count_occ_app, countMsg_enqMsgs.
    specialize (IHAtomic _ _ _ _ H6 idm); simpl in IHAtomic.
    destruct H14.
    assert (NoDup rins) by (apply idsOf_NoDup in H3; auto).
    pose proof (countMsg_deqMsgs msg_dec idm H3 H13).
    pose proof (count_occ_removeL (id_dec msg_dec) idm H1 H4).
    lia.
Qed.

Lemma atomic_messages_eouts_in:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      Forall (InMPI st2.(st_msgs)) eouts.
Proof.
  intros.
  apply Forall_forall; intros idm ?.
  apply (countMsg_InMPI msg_dec).
  eapply atomic_messages_eouts_count_le with (idm0:= idm) in H; eauto.
  apply (count_occ_In (id_dec msg_dec)) in H1.
  lia.
Qed.

Lemma atomic_messages_non_inits_count_eq:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      forall idm,
        ~ In idm inits ->
        countMsg msg_dec idm (st_msgs st1) +
        count_occ (id_dec msg_dec) eouts idm =
        countMsg msg_dec idm (st_msgs st2).
Proof.
  induction 1; simpl; intros; subst.
  - inv_steps; inv_step; simpl.
    rewrite countMsg_enqMsgs.
    destruct H11.
    pose proof (countMsg_deqMsgs msg_dec idm H1 H10).
    rewrite (count_occ_not_In (id_dec msg_dec)) in H0.
    lia.
  - inv_steps; inv_step; simpl.
    rewrite count_occ_app, countMsg_enqMsgs.
    rewrite Nat.add_assoc.
    specialize (IHAtomic _ _ _ _ H7 _ H6); simpl in IHAtomic.
    destruct H15.
    assert (NoDup rins) by (apply idsOf_NoDup in H3; auto).
    pose proof (countMsg_deqMsgs msg_dec idm H3 H14).
    pose proof (count_occ_removeL (id_dec msg_dec) idm H1 H4).
    lia.
Qed.

Lemma atomic_messages_in_in:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      forall idm,
        InMPI (st_msgs st1) idm ->
        ~ In idm inits ->
        InMPI (st_msgs st2) idm.
Proof.
  intros.
  apply (countMsg_InMPI msg_dec) in H1.
  apply (countMsg_InMPI msg_dec).
  pose proof (atomic_messages_non_inits_count_eq H H0 _ H2).
  lia.
Qed.

Corollary atomic_messages_ins_ins:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      forall msgs,
        Forall (InMPI (st_msgs st1)) msgs ->
        DisjList inits msgs ->
        Forall (InMPI (st_msgs st2)) msgs.
Proof.
  intros.
  rewrite Forall_forall in H1.
  apply Forall_forall; intros idm ?.
  eapply atomic_messages_in_in; eauto.
  destruct (H2 idm); auto.
Qed.

Lemma atomic_non_inits_InMPI_or:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      forall idm,
        ~ In idm inits ->
        InMPI st2.(st_msgs) idm ->
        InMPI st1.(st_msgs) idm \/ In idm eouts.
Proof.
  intros.
  eapply atomic_messages_non_inits_count_eq in H; [|eassumption..].
  apply (countMsg_InMPI msg_dec) in H2.
  assert (countMsg msg_dec idm st1.(st_msgs) > 0 \/
          count_occ (id_dec msg_dec) eouts idm > 0) by lia.
  destruct H3.
  - left; apply (countMsg_InMPI msg_dec); assumption.
  - right; apply (count_occ_In (id_dec msg_dec)); assumption.
Qed.

Lemma extAtomic_non_inits_InMPI_or:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) inits hst eouts,
    ExtAtomic sys inits hst eouts ->
    forall st1 st2,
      steps step_m sys st1 hst st2 ->
      forall idm,
        ~ In (idOf idm) (sys_merqs sys) ->
        InMPI st2.(st_msgs) idm ->
        InMPI st1.(st_msgs) idm \/ In idm eouts.
Proof.
  intros.
  inv H.
  eapply atomic_non_inits_InMPI_or; try eassumption.
  intro Hx.
  apply in_map with (f:= idOf) in Hx.
  apply H3 in Hx; auto.
Qed.

Lemma extAtomic_multi_non_inits_InMPI_or:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) st1,
    Reachable (steps step_m) sys st1 ->
    forall trss st2,
      steps step_m sys st1 (List.concat trss) st2 ->
      Forall AtomicEx trss ->
      Forall (Transactional sys) trss ->
      forall idm,
        ~ In (idOf idm) (sys_merqs sys) ->
        InMPI st2.(st_msgs) idm ->
        InMPI st1.(st_msgs) idm \/
        exists einits trs eouts,
          In trs trss /\
          ExtAtomic sys einits trs eouts /\
          In idm eouts.
Proof.
  induction trss as [|trs trss]; simpl; intros; [inv_steps; auto|].

  eapply steps_split in H0; [|reflexivity].
  destruct H0 as [sti [? ?]].
  inv H1; inv H2.
  pose proof (atomic_Transactional_ExtAtomic H8 H7).
  destruct H1 as [einits [eouts ?]].

  eapply extAtomic_non_inits_InMPI_or in H5; try eassumption.
  destruct H5; [|eauto 8].

  specialize (IHtrss _ H0 H9 H10 _ H3 H2).
  destruct IHtrss; [auto|].
  destruct H5 as [teinits [ttrs [teouts ?]]]; dest.
  right; eauto 7.
Qed.

Corollary extAtomic_multi_IntMsgsEmpty_non_inits_InMPI:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) st1,
    Reachable (steps step_m) sys st1 ->
    IntMsgsEmpty sys st1.(st_msgs) ->
    forall trss st2,
      steps step_m sys st1 (List.concat trss) st2 ->
      Forall AtomicEx trss ->
      Forall (Transactional sys) trss ->
      forall idm,
        In (idOf idm) (sys_minds sys) ->
        InMPI st2.(st_msgs) idm ->
        exists einits trs eouts,
          In trs trss /\
          ExtAtomic sys einits trs eouts /\
          In idm eouts.
Proof.
  intros.
  eapply extAtomic_multi_non_inits_InMPI_or in H1; try eassumption.
  - destruct H1; [|assumption].
    exfalso.
    specialize (H0 _ H4).
    apply findQ_length_ge_one in H1.
    rewrite H0 in H1; simpl in H1; lia.
  - eapply DisjList_In_2.
    + eapply sys_minds_sys_merqs_DisjList.
    + assumption.
Qed.

Lemma insLbl_IntMsgsEmpty:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) st1 lbl st2,
    step_m sys st1 lbl st2 ->
    IntMsgsEmpty sys st1.(st_msgs) ->
    InsLbl lbl ->
    IntMsgsEmpty sys st2.(st_msgs).
Proof.
  intros; red in H1.
  inv H; try (exfalso; auto; fail).
  simpl in *.
  red in H3; dest.
  red in H0; red; intros.
  specialize (H0 _ H4).
  rewrite findQ_not_In_enqMsgs.
  - assumption.
  - intro Hx; apply H in Hx.
    destruct (sys_minds_sys_merqs_DisjList sys midx); auto.
Qed.

Lemma insHistory_IntMsgsEmpty:
  forall `{dv: DecValue} `{oifc: OStateIfc} (sys: System) st1 hst st2,
    steps step_m sys st1 hst st2 ->
    IntMsgsEmpty sys st1.(st_msgs) ->
    InsHistory hst ->
    IntMsgsEmpty sys st2.(st_msgs).
Proof.
  induction 1; simpl; intros; auto.
  inv H2.
  eapply insLbl_IntMsgsEmpty; eauto.
Qed.

Lemma atomic_legal_eouts:
  forall `{dv: DecValue} (hst: History) inits ins outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      (forall nouts,
          removeL (id_dec msg_dec) (inits ++ outs ++ nouts) ins =
          removeL (id_dec msg_dec) (inits ++ outs) ins ++ nouts) /\
      eouts = removeL (id_dec msg_dec) (inits ++ outs) ins.
Proof.
  induction 1; simpl; intros; subst.
  - split.
    + intros.
      do 2 rewrite removeL_app_2.
      reflexivity.
    + rewrite removeL_app_2; reflexivity.
  - inv H5.
    specialize (IHAtomic _ _ _ _ H6).
    assert (NoDup rins) by (inv H8; destruct H14; apply idsOf_NoDup; auto).
    dest; subst; split.
    + intros.
      do 2 rewrite removeL_app_1.
      rewrite <-app_assoc.
      do 2 rewrite H3.
      do 2 (rewrite removeL_app_3 with (l3:= rins) by assumption).
      apply app_assoc.
    + rewrite removeL_app_1.
      rewrite H3.
      rewrite removeL_app_3 with (l3:= rins) by assumption.
      reflexivity.
Qed.

Lemma atomic_eouts_not_erqs:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall `{oifc: OStateIfc} (sys: System) st1 st2,
      steps step_m sys st1 hst st2 ->
      Forall (fun eout => ~ In (idOf eout) sys.(sys_merqs)) eouts.
Proof.
  induction 1; simpl; intros; subst.
  - inv_steps; inv_step.
    destruct H14.
    apply Forall_forall; intros [midx msg] ?.
    apply in_map with (f:= idOf) in H1.
    simpl in *.
    apply H in H1.
    eapply DisjList_In_2; [|eassumption].
    apply DisjList_app_4.
    + apply sys_minds_sys_merqs_DisjList.
    + apply DisjList_comm, sys_merqs_sys_merss_DisjList.
  - inv_steps.
    apply Forall_app; [apply forall_removeL; eauto|].
    inv_step.
    destruct H18.
    apply Forall_forall; intros [midx msg] ?.
    apply in_map with (f:= idOf) in H4.
    simpl in *.
    apply H2 in H4.
    eapply DisjList_In_2; [|eassumption].
    apply DisjList_app_4.
    + apply sys_minds_sys_merqs_DisjList.
    + apply DisjList_comm, sys_merqs_sys_merss_DisjList.
Qed.

Lemma atomic_inits_in:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    SubList inits ins.
Proof.
  induction 1; simpl; intros; subst;
    [apply SubList_refl|].
  apply SubList_app_1; auto.
Qed.

Lemma atomic_eouts_in:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    SubList eouts outs.
Proof.
  induction 1; simpl; intros; subst;
    [apply SubList_refl|].
  apply SubList_app_3.
  - eapply SubList_trans.
    + apply removeL_SubList_2.
    + apply SubList_app_1; auto.
  - apply SubList_app_2, SubList_refl.
Qed.

Lemma atomic_outs_cases:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall msg,
      In msg outs -> In msg eouts \/ In msg ins.
Proof.
  induction 1; simpl; intros; subst; auto.

  apply in_app_or in H5; destruct H5.
  - specialize (IHAtomic _ H2); destruct IHAtomic.
    + destruct (in_dec (id_dec msg_dec) msg rins).
      * right; apply in_or_app; auto.
      * left; apply in_or_app; left.
        apply removeL_In_1; auto.
    + right; apply in_or_app; auto.
  - left; apply in_or_app; auto.
Qed.

Lemma atomic_ins_cases:
  forall `{dv: DecValue} inits ins hst outs eouts,
    Atomic inits ins hst outs eouts ->
    forall msg,
      In msg ins -> In msg inits \/ In msg outs.
Proof.
  induction 1; simpl; intros; subst; auto.

  apply in_app_or in H5; destruct H5.
  - specialize (IHAtomic _ H2); destruct IHAtomic; auto.
    right; apply in_or_app; auto.
  - apply H1 in H2.
    pose proof (atomic_eouts_in H).
    apply H3 in H2.
    right; apply in_or_app; auto.
Qed.

Lemma atomic_app_SSubList:
  forall `{dv: DecValue} (hst1: History) inits1 ins1 outs1 eouts1,
    Atomic inits1 ins1 hst1 outs1 eouts1 ->
    forall hst2 inits2 ins2 outs2 eouts2,
      inits2 <> nil ->
      Atomic inits2 ins2 hst2 outs2 eouts2 ->
      SubList inits2 eouts1 ->
      exists eouts,
        SSubList eouts2 eouts /\
        Atomic inits1 (ins1 ++ ins2)
               (hst2 ++ hst1)
               (outs1 ++ outs2)
               eouts.
Proof.
  induction 3; simpl; intros.
  - eexists; split; [|econstructor; eauto].
    apply SSubList_app_1.
  - subst.
    specialize (IHAtomic H0 H7).
    destruct IHAtomic as [peouts [? ?]].

    eexists; split;
      [|apply SSubList_SubList in H4;
        do 2 rewrite app_assoc;
        econstructor; eauto;
        eapply SubList_trans; eauto].

    apply SSubList_app_2.
    apply SSubList_removeL_2; auto.
Qed.

Corollary atomic_app:
  forall `{dv: DecValue} (hst1: History) inits1 ins1 outs1 eouts1,
    Atomic inits1 ins1 hst1 outs1 eouts1 ->
    forall hst2 inits2 ins2 outs2 eouts2,
      inits2 <> nil ->
      Atomic inits2 ins2 hst2 outs2 eouts2 ->
      SubList inits2 eouts1 ->
      exists eouts,
        Atomic inits1 (ins1 ++ ins2)
               (hst2 ++ hst1)
               (outs1 ++ outs2)
               eouts.
Proof.
  intros.
  pose proof (atomic_app_SSubList H H0 H1 H2).
  dest; eauto.
Qed.


Require Import Extraction.
Require ExtrHaskellBasic.
Require ExtrHaskellNatInteger.
Require ExtrHaskellZInteger.
Extraction Language Haskell.
Unset Extraction SafeImplicits.

Require Import ZArith_base.

Extract Inlined Constant Z.of_nat => "".
Extract Inlined Constant Z.add => "(Prelude.+)".
Extract Inlined Constant Z.sub => "(Prelude.-)".
Extract Inlined Constant Z.succ => "(Prelude.+ 1)".
Extract Inlined Constant Z.opp => "Prelude.negate".

Require Import Base.

Extract Inlined Constant projP1 => "".

Require Import Kleene.

(* Declare the existence of Kleeneans *)
Parameter K : Set.
Axiom K_LazyBool : LazyBool K.

(* interpreting Kleeneans *)
Extract Inlined Constant K => "AERN2.CKleenean".

(* Erase the type class parameter and map to concrete types in Haskell. *)
Extraction Implicit lazy_bool_true [ LB ].
Extract Constant lazy_bool_true => "AERN2.ckleenean Prelude.True".

Extraction Implicit lazy_bool_false [ LB ].
Extract Constant lazy_bool_false => "AERN2.ckleenean Prelude.False".

Extraction Implicit lazy_bool_neg [ LB ].
Extract Constant lazy_bool_neg => "\x -> __uc (OGB.not (__K x))".

Extraction Implicit lazy_bool_or [ LB ].
Extract Constant lazy_bool_or => "\x y -> __uc ((__K x) OGB.|| (__K y))".

Extraction Implicit lazy_bool_and [ LB ].
Extract Constant lazy_bool_and => "\x y -> __uc ((__K x) OGB.&& (__K y))".

Extraction Implicit lazy_bool_defined_is_bool [ LB ].
Extract Inlined Constant lazy_bool_defined_is_bool => "Prelude.error ""UNREALIZED lazy_bool_defined_is_bool"" ".

(* Test extraction of Kleeneans *)

Section K_Dummy_Defs.
  Generalizable Variable K.
  Context `(klb : LazyBool K).
  Definition k_test := lazy_bool_and lazy_bool_true lazy_bool_false.
End K_Dummy_Defs.

(* Extraction Implicit k_test [ 1 ]. *)
(* Extraction "K_Test" k_test. *)

Require Import Monad.
Require Import ClassicalMonads.
Require Import MultivalueMonad.

(* Declare the existence of multivaluemonad *)
Parameter M : Type -> Type.
Axiom M_Monad : Monad M.
Axiom MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad.
Axiom M_MultivalueMonad : @MultivalueMonad _ K_LazyBool _ _ MultivalueMonad_description.

(* interpreting multivaluemonad *)
Extract Constant M "a" => "a".

Extraction Implicit Monad_fun_map [ Monad ].
Extract Inlined Constant Monad_fun_map => "__uc".

Extraction Implicit Monad_unit [ Monad ].
Extract Inlined Constant Monad_unit => "__uc".

Extraction Implicit Monad_mult [ Monad ].
Extract Inlined Constant Monad_mult => "__uc".

Extract Constant MultivalueMonad_description => "(Prelude.error ""UNREALIZED MultivalueMonad_description"")".

(* Shortcut extractions for improved readability. *)
Extraction Implicit M_unit [ M_Monad ].
Extract Inlined Constant M_unit => "__uc".
Extraction Implicit M_mult [ M_Monad ].
Extract Inlined Constant M_mult => "__uc".
Extraction Implicit M_lift [ M_Monad ].
Extract Inlined Constant M_lift => "__uc".
Extraction Implicit M_lift_dom [ M_Monad ].
Extract Inlined Constant M_lift_dom => "__uc".
Extraction Implicit mjoin [ M_Monad ].
Extract Inlined Constant mjoin => "__uc".

Extraction Implicit MultivalueMonad_base_monad_traces_lift [ klb M_Monad MultivalueMonad_description MultivalueMonad ].
Extract Constant MultivalueMonad_base_monad_traces_lift => "(\ x0 f -> __uc (\n -> Prelude.foldl (Prelude.flip (__uc f)) (x0) [0 .. ((n :: Prelude.Integer) Prelude.- 1)]))".

Extraction Implicit MultivalueMonad_base_monad_hprop_elim [ klb M_Monad MultivalueMonad_description MultivalueMonad ].
Extract Inlined Constant MultivalueMonad_base_monad_hprop_elim => "__uc".

Extraction Implicit multivalued_choice [ klb M_Monad MultivalueMonad_description MultivalueMonad ].
Extract Constant multivalued_choice => "(\k1 k2 -> __uc (AERN2.select (__K k1) (__K k2)))".

Extraction Implicit M_hprop_elim_f [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].
Extract Inlined Constant M_hprop_elim_f => "__uc".

Extraction Implicit choose [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].

Extraction Implicit M_paths [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].

Extraction Implicit semidec_or [ klb ].
Extraction Implicit semidec_and [ klb ].

(* (\ _ m -> m)  *)

(* MultivalueMonad_destruct *)
(* (\ _ m -> m) *)

Extraction Implicit select [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].

(* Some shortcuts for efficiency. *)
Extraction Implicit M_countable_lift [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].
Extract Inlined Constant M_countable_lift => "__uc".

(* Test extraction of multivaluemonad *)
Definition m_test := @select _ _ _ _ _ M_MultivalueMonad.
(* Extraction "M_Test" m_test. *)

Require Import Real.

(* Assume that there is R*)
Parameter R : Set.
Axiom R_SemiDecOrderedField : @SemiDecOrderedField  _ K_LazyBool R.
Axiom R_ComplArchiSemiDecOrderedField : @ComplArchiSemiDecOrderedField _ _ _ R_SemiDecOrderedField.

Extract Inlined Constant R => "AERN2.CReal".

Extraction Implicit real_0 [ klb SemiDecOrderedField ].
Extract Constant real_0 => "(__uc (0 :: AERN2.CReal))".

Extraction Implicit real_1 [ klb SemiDecOrderedField ].
Extract Constant real_1 => "(__uc (1 :: AERN2.CReal))".

Extraction Implicit real_2 [ klb SemiDecOrderedField_Real ].
Extract Constant real_2 => "(__uc (2 :: AERN2.CReal))".

(* Extraction Implicit real_3 [ klb SemiDecOrderedField_Real ]. *)
(* Extract Constant real_3 => "(__uc (3 :: AERN2.CReal))". *)

Extraction Implicit real_plus [ klb SemiDecOrderedField ].
Extract Constant real_plus => "(\x y -> __uc (((__R x) Prelude.+ (__R y))))".

Extraction Implicit real_mult [ klb SemiDecOrderedField ].
Extract Constant real_mult => "(\x y -> __uc (((__R x) Prelude.* (__R y))))".

Extraction Implicit real_opp [ klb SemiDecOrderedField ].
Extract Constant real_opp => "(\x -> __uc (Prelude.negate (__R x)))".

Extraction Implicit real_inv [ klb SemiDecOrderedField ].
Extract Constant real_inv => "(\x -> __uc (Prelude.recip (__R x)))".

Extraction Implicit real_lt_semidec [ klb SemiDecOrderedField ].
Extract Constant real_lt_semidec => "(\ x y -> __uc ((__R x) OGB.< (__R y)))".

Extraction Implicit real_limit_p [ klb SemiDecOrderedField_Real ComplArchiSemiDecOrderedField ].
Extract Constant real_limit_p => "(\ f -> __uc (AERN2.limit (__seqR f)))".

Extraction Implicit real_limit [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_limit_P [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_limit_P_p [ klb SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_limit_P_lt [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_limit_P_lt_p [ klb SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_mslimit_P [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_mslimit_P_p [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_mslimit_P_lt [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_mslimit_P_lt_p [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit M_split [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].

(* Some optional shortcuts for increased efficiency. *)
Extraction Implicit IZreal [ klb SemiDecOrderedField_Real ].
Extract Constant IZreal => "(\z -> __uc (AERN2.creal z))".
Extraction Implicit real_minus [ klb SemiDecOrderedField_Real ].
Extract Constant real_minus => "(\x y -> __uc (((__R x) Prelude.- (__R y))))".
Extraction Implicit real_div [ klb SemiDecOrderedField_Real ].
Extract Constant real_div => "(\x y -> __uc (((__R x) Prelude./ (__R y))))".
Extraction Implicit prec [ klb SemiDecOrderedField_Real ].
Extract Constant prec => "(\n -> __uc ((0.5 :: AERN2.CReal) Prelude.^ n))".

Extraction Implicit abs [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit abs_prop [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

(* Test extraction of R *)
Section Real_tests.
  Local Open Scope Real_scope.

  Generalizable Variables K M R.

  Context `{klb : LazyBool K} `{M_Monad : Monad M}
    {MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad}
    {M_MultivalueMonad : MultivalueMonad}
    {R : Type}
    {R_OF : SemiDecOrderedField R}.

  Definition real_test1 := (- real_1) + (IZreal 2) - (prec 2).
End Real_tests.

Extraction Implicit real_test1 [ klb R_OF ].
Definition R_test1 := @real_test1 _ _ R_SemiDecOrderedField.
(* Extraction "R_Test1" R_test1. *)

Definition R_test2 := @real_limit_p _ _ _ _ R_ComplArchiSemiDecOrderedField.
(* Extraction "R_Test2" R_test2. *)

Extract Inductive bool => "Prelude.Bool" [ "Prelude.True" "Prelude.False" ].
Extract Inductive sumbool => "Prelude.Bool" [ "Prelude.True" "Prelude.False" ].

Extract Inductive sigT => "(,)" ["(,)"].
Extract Inductive prod => "(,)"  [ "(,)" ].

Extract Inlined Constant Nat.log2 => "(MNP.integer Prelude.. Logs.integerLog2)".

(* Sewon's lab seminar talk material*)
(* Maximum *)

(* root finding function *)
Require Import IVT.

Extraction Implicit real_3 [ klb SemiDecOrderedField_Real ].
Extract Constant real_3 => "(__uc (3 :: AERN2.CReal))".

Extraction Implicit CIVT [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit root_approx [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit halving [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit trisect [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit M_uniq_pick [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Definition R_CIVT := @CIVT _ _ _ _ _ M_MultivalueMonad _ _ R_ComplArchiSemiDecOrderedField.

Extraction "IVT" R_CIVT.

(* maximum *)
Require Import Minmax.

Extraction Implicit real_max_prop [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].
Extraction Implicit real_max [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Definition R_real_max := @real_max _ _ _ _ _ M_MultivalueMonad _ _ R_ComplArchiSemiDecOrderedField.
Extraction "Max" R_real_max.

(* magnitude *)
Require Import testsearch.

Extraction Implicit weaken_orM_r [ M_Monad ].

Extraction Implicit epsilon_smallest_choose_M [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].

Extraction Implicit epsilon_smallest_PQ_M [ klb M_Monad MultivalueMonad_description M_MultivalueMonad ].

Require Import magnitude.

Extraction Implicit magnitude [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].
Extraction Implicit magnitude1 [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].
Extraction Implicit magnitude2 [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].
Extraction Implicit dec_x_lt_2 [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].

Extraction Implicit Zpow [ klb SemiDecOrderedField_Real ].

Definition R_magnitude := @magnitude _ _ _ _ _ M_MultivalueMonad _ R_SemiDecOrderedField.
Extraction "Magnitude" R_magnitude.

Require Import RealRing.

Extraction Implicit pow [ klb SemiDecOrderedField_Real ].

Require Import Complex.

Extraction Implicit complex0 [ klb SemiDecOrderedField_Real ].

Require Import Euclidean.

Extraction Implicit euclidean_max_dist [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real].

Extraction Implicit euclidean_mlimit_PQ [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real].

Extraction Implicit euclidean_max_norm [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real].

Extraction Implicit euclidean_limit [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real].

Extraction Implicit euclidean_zero [ klb SemiDecOrderedField_Real].

Extraction Implicit euclidean_opp [ klb SemiDecOrderedField_Real].

Extraction Implicit euclidean_plus [ klb SemiDecOrderedField_Real].

Extraction Implicit euclidean_minus [ klb SemiDecOrderedField_Real].

(* sqrt *)
Require Import sqrt.

Extraction Implicit sqrt [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit sqrt_pos [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit scale [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].

Extraction Implicit restr_sqrt [ klb SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit sqrt_approx_fast [ klb SemiDecOrderedField_Real ].

Extraction Implicit sqrt_approx [ klb SemiDecOrderedField_Real ].

Definition R_sqrt2 := @sqrt _ _ _ _ _ M_MultivalueMonad _ _ R_ComplArchiSemiDecOrderedField.
Extraction "Sqrt" R_sqrt2.

Extraction Implicit csqrt [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit csqrt_neq0 [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ComplArchiSemiDecOrderedField_Real ].

Extraction Implicit complex_nonzero_cases [ klb M_Monad MultivalueMonad_description M_MultivalueMonad SemiDecOrderedField_Real ].

Definition C_sqrt2 := @csqrt _ _ _ _ _ M_MultivalueMonad _ _ R_ComplArchiSemiDecOrderedField.
Extraction "CSqrt" C_sqrt2.

(* Require Import Nabla. *)

(* Require Import Coq.Reals.Abstract.ConstructiveMinMax. *)

(* Recursive Extraction CRmin. *)

(*

The Haskell module will require the following packages:
- cdar-mBound >= 0.1.0.1
- collect-errors >= 0.1.4
- mixed-types-num >= 0.5.3
- aern2-mp >= 0.2.1
- aern2-real >= 0.2.1
- integer-logarithms

In the generated Haskell files, add the following imports and definitions:

import MixedTypesNumPrelude (ifThenElse)
import qualified Numeric.OrdGenericBool as OGB
import qualified Unsafe.Coerce as UC
import qualified Control.Monad
import qualified Data.Functor
import qualified MixedTypesNumPrelude as MNP
import qualified Math.NumberTheory.Logarithms as Logs
import qualified AERN2.Real as AERN2

__uc :: a -> b
__uc = UC.unsafeCoerce
__K :: a -> AERN2.CKleenean
__K = UC.unsafeCoerce
__R :: a -> AERN2.CReal
__R = UC.unsafeCoerce
__seqR :: a -> (Prelude.Integer -> AERN2.CReal)
__seqR = UC.unsafeCoerce

*)