Require Export Rel.Compat_map_EV.
Require Export Rel.Compat_map_HV.
Require Export Rel.Compat_weaken_X.

Require Import Rel.Definitions.
Require Import Rel.Compat_weaken_X.
Require Import Rel.Compat_map_EV.
Require Import Rel.Compat_map_HV.
Require Import Util.Subset.
Require Import Lang.Static.
Require Import Lang.BindingsFacts.
Require Import Lang.StaticFacts.
Set Implicit Arguments.

Section section_closed_weaken.
Context (EV HV : Set).
Context (Ξ : XEnv EV HV).
Context (δ₁ δ₂ : EV → eff0) (δ : EV → IRel 𝓤_Sig).
Context (ρ₁ ρ₂ : HV → hd0) (ρ : HV → IRel 𝓣_Sig).
Context (T : ty0).
Context (Wf_Ξ : wf_XEnv Ξ).
Context (Wf_T : wf_ty empty T).

Hint Rewrite concat_empty_l EV_map_XEnv_empty HV_map_XEnv_empty.
Hint Resolve HV_map_wf_ty EV_map_wf_ty.

Fact closed_weaken_𝓥 n ξ₁ ξ₂ t₁ t₂ :
n ⊨ 𝓥⟦ empty ⊢ T ⟧ ∅→ ∅→ ∅→ ∅→ ∅→ ∅→ ξ₁ ξ₂ t₁ t₂ ⇔
    𝓥⟦ Ξ ⊢ HV_open_ty (EV_open_ty T) ⟧ δ₁ δ₂ δ ρ₁ ρ₂ ρ ξ₁ ξ₂ t₁ t₂.
Proof.
replace Ξ with ((HV_map_XEnv ∅→ (EV_map_XEnv ∅→ empty)) & Ξ) by crush.
eapply I_iff_transitive ; [ | apply X_weaken_𝓥 ; crush ].
eapply I_iff_transitive ; [ apply EV_map_𝓥 | apply HV_map_𝓥 ] ; auto.
Qed.

End section_closed_weaken.


Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.omega.Omega.
Require Import Coq.Lists.List.
Require Import Coq.Strings.String.
Import ListNotations.
Require Import Maps.
Require Import Program.
Require Import Interval.

Section List_map.

Variable A : Type.

Variable default : A.

Definition list_map := list (id * A).

Fixpoint list_to_map (ls : list_map) :=
  match ls with
  | nil => t_empty default
  | cons (hd1, hd2) tl => t_update (list_to_map tl) hd1 hd2
  end.

Fixpoint update (ls : list_map) (x : id) (v : A) :=
  match ls with
  | nil => [(x, v)]
  | (hd1, hd2) :: tl =>
    if beq_id x hd1 then
      (x, v) :: tl
    else
      (hd1, hd2) :: update tl x v
  end.

Lemma update_spec : forall (ls : list_map) (x : id) (v : A) (x' : id),
  list_to_map (update ls x v) x' = t_update (list_to_map ls) x v x'.
Proof.
  intros. induction ls; auto.
  simpl; destruct a as [hd1 hd2]; destruct (beq_id x hd1) eqn:?.
  - rewrite beq_id_true_iff in *.
    subst hd1. rewrite t_update_shadow. auto.
  - rewrite beq_id_false_iff in *.
    rewrite t_update_permute by auto.
    simpl. unfold t_update at 1 2. rewrite IHls. auto.
Qed.

Fixpoint has_key (ls : list_map) (x : id) : bool :=
  match ls with
  | nil => false
  | (hd1, hd2) :: tl =>
    if beq_id hd1 x then true else has_key tl x
  end.

Lemma not_has_key_default : forall (ls : list_map) (x : id),
  has_key ls x = false ->
  list_to_map ls x = default.
Proof.
  intros; induction ls.
  - auto.
  - simpl. destruct a as [hd1 hd2]. unfold t_update.
    simpl in H. destruct (beq_id hd1 x); try discriminate.
    auto.
Qed.

Fixpoint merge_aux_l (l s : list_map) (f : A -> A -> A) : list_map :=
  match l with
    | nil => nil
    | (hd1, hd2) :: tl =>
      (hd1, f hd2 (list_to_map s hd1)) :: merge_aux_l tl s f
    end.

Fixpoint merge_aux_s (l s : list_map) (f : A -> A -> A) (new_l : list_map): list_map :=
    match s with
    | nil => new_l
    | (hd1, hd2) :: tl =>
      if has_key l hd1
      then merge_aux_s l tl f new_l
      else (hd1, f default hd2) :: merge_aux_s l tl f new_l
    end.

Definition merge (l s : list_map) (f : A -> A -> A) : list_map :=
  merge_aux_s l s f (merge_aux_l l s f).

Theorem merge_spec : forall (l s : list_map) (f : A -> A -> A) (x : id),
  f default default = default ->
  list_to_map (merge l s f) x = f (list_to_map l x) (list_to_map s x).
Proof.
  intros.
  destruct (has_key l x) eqn:?.
  - (* has_key l x = true *)
    replace (list_to_map (merge l s f) x) with (list_to_map (merge_aux_l l s f) x). 2: {
      unfold merge. set (new_l := merge_aux_l l s f). clearbody new_l.
      induction s.
      + auto.
      + simpl. destruct a as [hd1 hd2].
        destruct (has_key l hd1) eqn:?; auto.
        simpl. unfold t_update.
        destruct (beq_id hd1 x) eqn:?; auto.
        rewrite beq_id_true_iff in *. congruence.
    }
    induction l.
    + inversion Heqb.
    + simpl. destruct a as [hd1 hd2]. simpl.
      unfold t_update.
      simpl in Heqb.
      destruct (beq_id hd1 x) eqn:?.
      * rewrite beq_id_true_iff in *. congruence.
      * auto.
  - (* has_key l x = false *)
    unfold merge. set (new_l := merge_aux_l l s f).
    assert (list_to_map l x = default). {
      induction l.
      + auto.
      + simpl. destruct a as [hd1 hd2]. unfold t_update.
        simpl in Heqb. destruct (beq_id hd1 x) eqn:?.
        * discriminate.
        * auto.
    }
    assert (list_to_map new_l x = default). {
      subst new_l. clear H0. induction l.
      + auto.
      + simpl. destruct a as [hd1 hd2]. simpl. unfold t_update.
        simpl in Heqb. destruct (beq_id hd1 x) eqn:?.
        * discriminate.
        * auto.
    }
    clearbody new_l.
    induction s.
    + simpl. unfold t_empty. congruence.
    + simpl. destruct a as [hd1 hd2].
      destruct (has_key l hd1) eqn:?.
      * unfold t_update.
        destruct (beq_id hd1 x) eqn:?.
        -- rewrite beq_id_true_iff in *. congruence.
        -- auto.
      * simpl. unfold t_update.
        destruct (beq_id hd1 x) eqn:?.
        -- rewrite beq_id_true_iff in *. congruence.
        -- auto.
Qed.

(*
Fixpoint merge_option_aux_l (l s : list_map) (f : A -> A -> option A) : option list_map :=
  match l with
    | nil => Some nil
    | (hd1, hd2) :: tl =>
      match f hd2 (list_to_map s hd1) with
      | None => None
      | Some new_hd2 =>
        match merge_option_aux_l tl s f with
        | None => None
        | Some res =>
          Some ((hd1, new_hd2) :: res)
        end
      end
    end.

Fixpoint merge_option_aux_s (l s : list_map) (f : A -> A -> option A) (new_l : option list_map): option list_map :=
    match s with
    | nil => new_l
    | (hd1, hd2) :: tl =>
      if has_key l hd1
      then merge_option_aux_s l tl f new_l
      else
        match f default hd2 with
        | None => None
        | Some new_hd2 =>
          match merge_option_aux_s l tl f new_l with
          | None => None
          | Some res =>
            Some ((hd1, new_hd2) :: res)
          end
        end
    end.

Definition merge_option (l s : list_map) (f : A -> A -> option A) : option list_map :=
  merge_option_aux_s l s f (merge_option_aux_l l s f).

Theorem merge_option_spec : forall (l s : list_map) (f : A -> A -> option A),
  f default default = Some default ->
  (exists (x : id), f (list_to_map l x) (list_to_map s x) = None) /\ list_to_map (merge l s f) = None
  \/
  forall (x : id), f (list_to_map l x) (list_to_map s x) <> None) /\ list_to_map (merge l s f) = None
  list_to_map (merge l s f) x = f (list_to_map l x) (list_to_map s x).
Proof.
  intros.
  destruct (has_key l x) eqn:?.
  - (* has_key l x = true *)
    replace (list_to_map (merge l s f) x) with (list_to_map (merge_aux_l l s f) x). 2: {
      unfold merge. set (new_l := merge_aux_l l s f). clearbody new_l.
      induction s.
      + auto.
      + simpl. destruct a as [hd1 hd2].
        destruct (has_key l hd1) eqn:?; auto.
        simpl. unfold t_update.
        destruct (beq_id hd1 x) eqn:?; auto.
        rewrite beq_id_true_iff in *. congruence.
    }
    induction l.
    + inversion Heqb.
    + simpl. destruct a as [hd1 hd2]. simpl.
      unfold t_update.
      simpl in Heqb.
      destruct (beq_id hd1 x) eqn:?.
      * rewrite beq_id_true_iff in *. congruence.
      * auto.
  - (* has_key l x = false *)
    unfold merge. set (new_l := merge_aux_l l s f).
    assert (list_to_map l x = default). {
      induction l.
      + auto.
      + simpl. destruct a as [hd1 hd2]. unfold t_update.
        simpl in Heqb. destruct (beq_id hd1 x) eqn:?.
        * discriminate.
        * auto.
    }
    assert (list_to_map new_l x = default). {
      subst new_l. clear H0. induction l.
      + auto.
      + simpl. destruct a as [hd1 hd2]. simpl. unfold t_update.
        simpl in Heqb. destruct (beq_id hd1 x) eqn:?.
        * discriminate.
        * auto.
    }
    clearbody new_l.
    induction s.
    + simpl. unfold t_empty. congruence.
    + simpl. destruct a as [hd1 hd2].
      destruct (has_key l hd1) eqn:?.
      * unfold t_update.
        destruct (beq_id hd1 x) eqn:?.
        -- rewrite beq_id_true_iff in *. congruence.
        -- auto.
      * simpl. unfold t_update.
        destruct (beq_id hd1 x) eqn:?.
        -- rewrite beq_id_true_iff in *. congruence.
        -- auto.
Qed. *)

End List_map.

Definition assertion : Type := option (list_map interval).

Definition bottom : assertion := None.

Definition default : assertion := Some nil.

Definition list_assertion_to_map : list_map interval -> total_map interval :=
  list_to_map interval default_interval.

Definition assertion_to_map (s : assertion) : total_map interval :=
  match s with
  | Some l => list_assertion_to_map l
  | None => list_to_map interval empty_interval nil
  end.

Definition state_in_range (st : state) (m : total_map interval) : Prop :=
  forall (x : id), include (m x) (st x).

Definition state_in_assertion (st : state) (s : assertion) :=
  state_in_range st (assertion_to_map s).

Notation "st |= s" := (state_in_assertion st s) (at level 18).

Definition assertion_in_assertion (s1 : assertion) (s2 : assertion) :=
  forall st : state, state_in_assertion st s1 -> state_in_assertion st s2.

Notation "s1 |== s2" := (assertion_in_assertion s1 s2) (at level 18).

Lemma assertion_in_assertion_trans : forall (s s' s'' : assertion),
  s |== s' ->
  s' |== s'' ->
  s |== s''.
Proof.
  unfold assertion_in_assertion. intros. auto.
Qed.

(* Operations on assertions *)

Fixpoint list_leb (l1 l2 : list_map interval) : bool :=
  match l1 with
  | nil => true
  | cons (hd1, hd2) tl =>
    Interval.leb hd2 (list_assertion_to_map l2 hd1) && list_leb tl l2
  end.

Fixpoint list_geb (l1 l2 : list_map interval) : bool :=
  match l1 with
  | nil => true
  | cons (hd1, hd2) tl =>
    Interval.geb hd2 (list_assertion_to_map l2 hd1) && list_geb tl l2
  end.

Fixpoint list_eqb (l1 l2 : list_map interval) : bool :=
  match l1 with
  | nil => true
  | cons (hd1, hd2) tl =>
    Interval.eqb hd2 (list_assertion_to_map l2 hd1) && list_eqb tl l2
  end.

Definition leb (s1 s2 : assertion) : bool :=
  match s1, s2 with
  | None, _ => true
  | _, None => false
  | Some l1, Some l2 =>
    list_leb l1 l2 && list_geb l2 l1
  end.

Definition geb (s1 s2 : assertion) : bool :=
  leb s2 s1.

Definition eqb (s1 s2 : assertion) : bool :=
  match s1, s2 with
  | None, None => true
  | Some l1, Some l2 =>
    list_eqb l1 l2 && list_eqb l2 l1
  | _, _ => false
  end.

(* Props on assertions *)

Definition le (s1 s2 : assertion) : Prop :=
  forall x, Interval.le (assertion_to_map s1 x) (assertion_to_map s2 x).

Definition feq (s1 s2 : assertion) : Prop :=
  forall x, Interval.feq (assertion_to_map s1 x) (assertion_to_map s2 x).

Lemma list_leb_prop : forall x l1 l2,
  list_leb l1 l2 = true ->
  list_assertion_to_map l1 x <> default_interval ->
  Interval.le (list_assertion_to_map l1 x) (list_assertion_to_map l2 x).
Proof.
  intros.
  induction l1.
  - (* l1 = nil *)
    exfalso. apply H0. auto.
  - (* l1 = cons *)
    destruct a as [y r].
    simpl in *. unfold t_update in *.
    destruct (beq_id y x) eqn:Heq.
    + rewrite beq_id_true_iff in Heq.
      subst. apply Interval.leb_le.
      apply andb_prop in H. tauto.
    + apply IHl1.
      * apply andb_prop in H. tauto.
      * auto.
Qed.

Lemma list_geb_prop : forall x l1 l2,
  list_geb l1 l2 = true ->
  list_assertion_to_map l1 x <> default_interval ->
  Interval.ge (list_assertion_to_map l1 x) (list_assertion_to_map l2 x).
Proof.
  intros.
  induction l1.
  - (* l1 = nil *)
    exfalso. apply H0. auto.
  - (* l1 = cons *)
    destruct a as [y r].
    simpl in *. unfold t_update in *.
    destruct (beq_id y x) eqn:Heq.
    + rewrite beq_id_true_iff in Heq.
      subst. apply Interval.leb_le.
      apply andb_prop in H. tauto.
    + apply IHl1.
      * apply andb_prop in H. tauto.
      * auto.
Qed.

Lemma leb_le : forall s1 s2,
  leb s1 s2 = true ->
  forall x,
  Interval.le (assertion_to_map s1 x) (assertion_to_map s2 x).
Proof.
  intros.
  destruct s1 as [l1 | ]; destruct s2 as [l2 | ]; simpl; try discriminate.
  apply andb_prop in H. destruct H.
  pose (list_leb_prop x _ _ H) as Hleb.
  pose (list_geb_prop x _ _ H0) as Hgeb.
  destruct (Interval.eq_dec (list_assertion_to_map l1 x) (default_interval));
  destruct (Interval.eq_dec (list_assertion_to_map l2 x) (default_interval));
  try solve [apply Hleb; auto];
  try solve [apply Hgeb; auto].
  rewrite e, e0.
  all : apply Interval.leb_le; compute; auto.
Qed.

Lemma list_eqb_prop : forall x l1 l2,
  list_eqb l1 l2 = true ->
  list_assertion_to_map l1 x <> default_interval ->
  Interval.feq (list_assertion_to_map l1 x) (list_assertion_to_map l2 x).
Proof.
  intros.
  induction l1.
  - (* l1 = nil *)
    exfalso. apply H0. auto.
  - (* l1 = cons *)
    destruct a as [y r].
    simpl in *. unfold t_update in *.
    destruct (beq_id y x) eqn:Heq.
    + rewrite beq_id_true_iff in Heq.
      subst. apply Interval.eqb_feq.
      apply andb_prop in H. tauto.
    + apply IHl1.
      * apply andb_prop in H. tauto.
      * auto.
Qed.

Lemma eqb_feq : forall x s1 s2,
  eqb s1 s2 = true ->
  Interval.feq (assertion_to_map s1 x) (assertion_to_map s2 x).
Proof.
  intros.
  destruct s1 as [l1 | ]; destruct s2 as [l2 | ]; simpl; try discriminate.
  apply andb_prop in H. destruct H.
  pose (list_eqb_prop x _ _ H) as Heqb1.
  pose (list_eqb_prop x _ _ H0) as Heqb2.
  destruct (Interval.eq_dec (list_assertion_to_map l1 x) (default_interval));
  destruct (Interval.eq_dec (list_assertion_to_map l2 x) (default_interval));
  try solve [apply Heqb1; auto];
  try solve [apply Interval.feq_sym; apply Heqb2; auto].
  rewrite e, e0.
  all : apply Interval.eqb_feq; compute; auto.
Qed.

Lemma le_assertion_in_assertion : forall s1 s2,
  le s1 s2 -> s1 |== s2.
Proof.
  unfold le, assertion_in_assertion.
  intros. intro x.
  apply H. apply H0.
Qed.

Definition join_base (s1 s2 : assertion) (f : interval -> interval -> interval) : assertion :=
  match s1, s2 with
  | None, _ => s2
  | _, None => s1
  | Some l1, Some l2 =>
    Some (merge _ default_interval l1 l2 f)
  end.

Theorem join_base_sound : forall (s1 s2 : assertion) (f : interval -> interval -> interval),
  f default_interval default_interval = default_interval ->
  (forall x y, Interval.le x (f x y)) ->
  (forall x y, Interval.le y (f x y)) ->
  le s1 (join_base s1 s2 f) /\ le s2 (join_base s1 s2 f).
Proof.
  intros. unfold le.
  destruct s1 as [l1 | ]; destruct s2 as [l2 | ];
  split; intros; simpl; unfold t_empty;
  try apply empty_interval_le_all;
  try apply interval_le_refl;
  unfold list_assertion_to_map;
  rewrite merge_spec; auto.
Qed.

Definition join (s1 s2 : assertion) :=
  join_base s1 s2 Interval.join.

Theorem join_sound : forall (s1 s2 : assertion),
  le s1 (join s1 s2) /\ le s2 (join s1 s2).
Proof.
  intros. apply join_base_sound; auto.
  all: intros; pose (Interval.join_sound x y); tauto.
Qed.

Definition join_widen (s1 s2 : assertion) :=
  join_base s1 s2 Interval.widen.

Theorem join_widen_sound : forall (s1 s2 : assertion),
  le s1 (join_widen s1 s2) /\ le s2 (join_widen s1 s2).
Proof.
  intros. apply join_base_sound; auto.
  all: intros; pose (Interval.widen_sound x y); tauto.
Qed.

Fixpoint has_empty (l s : list_map interval) : bool :=
  match l with
  | nil => false
  | (hd1, hd2) :: tl => emptyb hd2 && negb (has_key _ s hd1) || has_empty tl ((hd1, hd2) :: s)
  end.

Definition rectify_empty (s : assertion) : assertion :=
  match s with
  | None => None
  | Some l => if has_empty l nil then None else s
  end.

Lemma has_empty_exists_empty : forall (l s : list_map interval),
  has_empty l s = true ->
  exists (x : id),
  (forall (n : Z), ~include (assertion_to_map (Some l) x) n) /\
  has_key _ s x = false.
Proof.
  intros l. induction l; intros.
  - inversion H.
  - destruct a as [hd1 hd2]. simpl in H.
    destruct (emptyb hd2 && negb (has_key interval s hd1)) eqn:?.
    + destruct (emptyb hd2) eqn:?;
      destruct (has_key interval s hd1) eqn:?; simpl in *; try congruence.
      exists hd1. split; auto.
      intros. unfold t_update; rewrite <- beq_id_refl. intro.
      assert (emptyb hd2 = false) by (eapply include_non_empty; eauto).
      congruence.
    + apply orb_prop in H. destruct H; try discriminate.
      specialize (IHl _ H).
      destruct IHl as [x IHl]. exists x.
      simpl in IHl. destruct IHl. destruct (beq_id hd1 x) eqn:?; try congruence.
      split; auto.
      intros. simpl. unfold t_update. rewrite Heqb0. auto.
Qed.

Lemma rectify_empty_sound : forall (s : assertion),
  s |== (rectify_empty s).
Proof.
  intro;
  destruct s as [l | ]; simpl; try destruct (has_empty l []) eqn:H;
  try solve [apply le_assertion_in_assertion;
    unfold le;
    simpl; intros; unfold t_empty;
    try rewrite H;
    try apply interval_le_refl;
    try apply empty_interval_le_all].
  pose (has_empty_exists_empty _ _ H) as H0.
  destruct H0 as [x []].
  intros st Hst.
  specialize (Hst x). exfalso. eapply H0. eauto.
Qed.

Definition meet (s1 s2 : assertion) : assertion :=
  match s1, s2 with
  | Some l1, Some l2 =>
    rectify_empty (Some (merge _ default_interval l1 l2 Interval.meet))
  | _, _ => None (* at least a None *)
  end.

Lemma bottom_implies_all : forall (s : assertion),
  None |== s.
Proof.
  intros. apply le_assertion_in_assertion. unfold le.
  intros. simpl. unfold t_empty. eapply empty_interval_le_all.
Qed.

Lemma merge_meet_sound : forall (l1 l2 : list_map interval),
  forall (st : state),
  st |= (Some l1) ->
  st |= (Some l2) ->
  st |= (Some (merge _ default_interval l1 l2 Interval.meet)).
Proof.
  intros. unfold state_in_assertion. simpl.
  unfold list_assertion_to_map. intro x. rewrite merge_spec by auto.
  apply meet_sound.
  - apply H.
  - apply H0.
Qed.

Theorem meet_sound : forall (s1 s2 : assertion),
  forall (st : state),
  st |= s1 ->
  st |= s2 ->
  st |= (meet s1 s2).
Proof.
  intros.
  destruct s1 as [l1 | ]; destruct s2 as [l2 | ];
  try (intro; specialize (H x); specialize (H0 x); simpl in *; omega).
  unfold meet.
  apply rectify_empty_sound, merge_meet_sound; auto.
Qed.

Definition assign (s : assertion) (x : id) (r : interval) : assertion :=
  if emptyb r
  then None
  else
    match s with
    | None => None
    | Some l => Some (update _ l x r)
    end.

Theorem assign_sound : forall (s : assertion) (x : id) (r : interval) (st : state) (n : Z),
  st |= s ->
  include r n ->
  t_update st x n |= assign s x r.
Proof.
  intros. intro y.
  unfold assign.
  destruct (emptyb r) eqn:?.
  - (* emptyb r = true *)
    pose (include_non_empty r n ltac:(auto)). congruence.
  - (* emptyb r = false *)
    destruct s; simpl.
    + (* s = Some l *)
      unfold list_assertion_to_map. rewrite update_spec.
      unfold t_update. destruct (beq_id x y).
      * auto.
      * apply H.
    + (* s = None *)
      specialize (H x). simpl in H. omega.
Qed.

Lemma assign_sound2 : forall (s : assertion) (x : id) (r : interval) (st : state) (n : Z),
  st |= s ->
  include r n ->
  st x = n ->
  st |= assign s x r.
Proof.
  intros. intro y.
  unfold assign.
  destruct (emptyb r) eqn:?.
  - (* emptyb r = true *)
    pose (include_non_empty r n ltac:(auto)). congruence.
  - (* emptyb r = false *)
    destruct s; simpl.
    + (* s = Some l *)
      unfold list_assertion_to_map. rewrite update_spec.
      unfold t_update. destruct (beq_id x y) eqn:?.
      * rewrite beq_id_true_iff in *. subst y. congruence.
      * apply H.
    + (* s = None *)
      specialize (H x). simpl in H. omega.
Qed.

Definition assign_option (s : assertion) (x : option id) (r : interval) : assertion :=
  if emptyb r then None else
  match x with
  | None => s
  | Some x => assign s x r
  end.

Definition mapsto_option (st : state) (x : option id) (n : Z) : Prop :=
  match x with
  | None => True
  | Some x => st x = n
  end.

Lemma assign_option_sound : forall (s : assertion) (x : option id) (r : interval) (st : state) (n : Z),
  st |= s ->
  mapsto_option st x n ->
  include r n ->
  st |= assign_option s x r.
Proof.
  intros. assert (emptyb r = false). {
    eapply include_non_empty; eauto.
  }
  destruct x; simpl in *; unfold assign_option; rewrite H2; auto.
  eapply assign_sound2; eauto.
Qed.

Definition eq_cond (s : assertion) (x y : option id) (r1 r2 : interval) (ans : bool) : assertion :=
  let new_r1 := Interval.eq_cond1 r1 r2 ans in
  let new_r2 := Interval.eq_cond2 r1 r2 ans in
  assign_option (assign_option s y new_r2) x new_r1.

Lemma eq_cond_sound : forall (s : assertion) (x y : option id) (r1 r2 : interval) (ans : bool) (st : state) (n m : Z),
  st |= s ->
  mapsto_option st x n ->
  mapsto_option st y m ->
  include r1 n ->
  include r2 m ->
  n =? m = ans ->
  st |= eq_cond s x y r1 r2 ans.
Proof.
  intros.
  eapply assign_option_sound; eauto.
  - eapply assign_option_sound; eauto.
    eapply eq_cond2_sound; eauto.
  - eapply eq_cond1_sound; eauto.
Qed.

Definition le_cond (s : assertion) (x y : option id) (r1 r2 : interval) (ans : bool) : assertion :=
  let new_r1 := Interval.le_cond1 r1 r2 ans in
  let new_r2 := Interval.le_cond2 r1 r2 ans in
  assign_option (assign_option s y new_r2) x new_r1.

Lemma le_cond_sound : forall (s : assertion) (x y : option id) (r1 r2 : interval) (ans : bool) (st : state) (n m : Z),
  st |= s ->
  mapsto_option st x n ->
  mapsto_option st y m ->
  include r1 n ->
  include r2 m ->
  n <=? m = ans ->
  st |= le_cond s x y r1 r2 ans.
Proof.
  intros.
  eapply assign_option_sound; eauto.
  - eapply assign_option_sound; eauto.
    eapply le_cond2_sound; eauto.
  - eapply le_cond1_sound; eauto.
Qed.

(*
Definition le_cond (s : assertion) (x : id) (y : interval) : assertion :=
  assign s x (Interval.le_cond (assertion_to_map s x) y).

Lemma le_cond_sound : forall (s : assertion) (x : id) (y : interval) (st : state) (n : Z),
  include y n ->
  st |= s ->
  st x <=? n = true ->
  st |= le_cond s x y.
Proof.
  intros. apply assign_sound2 with (n := st x); auto.
  apply Interval.le_cond_sound with n; auto. arith.
Qed.

Definition ge_cond (s : assertion) (x : id) (y : interval) : assertion :=
  assign s x (Interval.ge_cond (assertion_to_map s x) y).

Lemma ge_cond_sound : forall (s : assertion) (x : id) (y : interval) (st : state) (n : Z),
  include y n ->
  st |= s ->
  n <=? st x = true ->
  st |= ge_cond s x y.
Proof.
  intros. apply assign_sound2 with (n := st x); auto.
  apply Interval.ge_cond_sound with n; auto. arith.
Qed.
*)


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require Reals.Rfunctions.
Require BuiltIn.
Require HighOrd.
Require int.Int.
Require int.Abs.
Require int.EuclideanDivision.
Require real.Real.
Require real.RealInfix.
Require real.PowerInt.
Require map.Map.

Axiom t : Type.
Parameter t_WhyType : WhyType t.
Existing Instance t_WhyType.

(* Why3 assumption *)
Inductive ref (a:Type) :=
  | mk_ref : a -> ref a.
Axiom ref_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (ref a).
Existing Instance ref_WhyType.
Arguments mk_ref {a}.

(* Why3 assumption *)
Definition contents {a:Type} {a_WT:WhyType a} (v:ref a) : a :=
  match v with
  | mk_ref x => x
  end.

Parameter power: Z -> Z -> Z.

Axiom Assoc :
  forall (x:Z) (y:Z) (z:Z), (((x * y)%Z * z)%Z = (x * (y * z)%Z)%Z).

Axiom Unit_def_l : forall (x:Z), ((1%Z * x)%Z = x).

Axiom Unit_def_r : forall (x:Z), ((x * 1%Z)%Z = x).

Axiom Power_0 : forall (x:Z), ((power x 0%Z) = 1%Z).

Axiom Power_s :
  forall (x:Z) (n:Z), (0%Z <= n)%Z ->
  ((power x (n + 1%Z)%Z) = (x * (power x n))%Z).

Axiom Power_s_alt :
  forall (x:Z) (n:Z), (0%Z < n)%Z ->
  ((power x n) = (x * (power x (n - 1%Z)%Z))%Z).

Axiom Power_1 : forall (x:Z), ((power x 1%Z) = x).

Axiom Power_sum :
  forall (x:Z) (n:Z) (m:Z), (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((power x (n + m)%Z) = ((power x n) * (power x m))%Z).

Axiom Power_mult :
  forall (x:Z) (n:Z) (m:Z), (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((power x (n * m)%Z) = (power (power x n) m)).

Axiom Power_comm1 :
  forall (x:Z) (y:Z), ((x * y)%Z = (y * x)%Z) -> forall (n:Z),
  (0%Z <= n)%Z -> (((power x n) * y)%Z = (y * (power x n))%Z).

Axiom Power_comm2 :
  forall (x:Z) (y:Z), ((x * y)%Z = (y * x)%Z) -> forall (n:Z),
  (0%Z <= n)%Z -> ((power (x * y)%Z n) = ((power x n) * (power y n))%Z).

Axiom growing_mult :
  forall (n:Z) (m:Z), (0%Z <= n)%Z -> (1%Z <= m)%Z -> (n <= (n * m)%Z)%Z.

Axiom strict_growing_mult :
  forall (n:Z) (m:Z), (1%Z < n)%Z -> (1%Z < m)%Z -> (n < (n * m)%Z)%Z.

Axiom positive_diff : forall (n:Z) (m:Z), (n < m)%Z -> (0%Z < (m - n)%Z)%Z.

Axiom init_exp :
  forall (k:Z),
  ((power k 0%Z) = 1%Z) /\
  (((power k 1%Z) = k) /\ ((power k 2%Z) = (k * k)%Z)).

Axiom sum_exp :
  forall (k:Z) (n:Z) (m:Z), (0%Z <= k)%Z -> (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((power k (n + m)%Z) = ((power k n) * (power k m))%Z) /\
  (((power k (n + m)%Z) = ((power k m) * (power k n))%Z) /\
   (((power k (n + 1%Z)%Z) = (k * (power k n))%Z) /\
    (((k * (power k n))%Z = ((power k n) * k)%Z) /\
     ((((power k n) * k)%Z = ((power k 1%Z) * (power k n))%Z) /\
      (((power k 1%Z) * (power k n))%Z = ((power k n) * (power k 1%Z))%Z))))).

Axiom positive_exp :
  forall (k:Z) (n:Z), (0%Z < k)%Z -> (0%Z <= n)%Z ->
  (1%Z <= (power k n))%Z /\
  ((0%Z < (power k n))%Z /\ ((power k n) <= (power k (n + 1%Z)%Z))%Z).

Axiom strict_positive_exp :
  forall (k:Z) (n:Z), (1%Z < k)%Z -> (0%Z < n)%Z ->
  (1%Z < (power k n))%Z /\
  (((power k (n - 1%Z)%Z) < (power k n))%Z /\
   ((power k n) < (power k (n + 1%Z)%Z))%Z).

Axiom growing_exp :
  forall (k:Z) (m:Z) (n:Z), (1%Z <= k)%Z -> ((0%Z <= m)%Z /\ (m <= n)%Z) ->
  ((power k m) <= (power k n))%Z.

Axiom strict_growing_exp :
  forall (k:Z) (m:Z) (n:Z), (1%Z < k)%Z -> ((0%Z <= m)%Z /\ (m < n)%Z) ->
  ((power k m) < (power k n))%Z.

Axiom unicity_exp :
  forall (k:Z) (m:Z) (n:Z), (1%Z < k)%Z -> (0%Z <= m)%Z -> (0%Z <= n)%Z ->
  ((power k m) = (power k n)) <-> (m = n).

Axiom div_plus_one :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  (((int.EuclideanDivision.div i j) * j)%Z <= i)%Z /\
  (i < (((int.EuclideanDivision.div i j) + 1%Z)%Z * j)%Z)%Z.

Axiom bound_mod :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  (0%Z <= (int.EuclideanDivision.mod1 i j))%Z /\
  ((int.EuclideanDivision.mod1 i j) < j)%Z.

Axiom unicity_div_mod :
  forall (i:Z) (j:Z) (q:Z) (r:Z), (0%Z <= i)%Z -> (0%Z <= q)%Z ->
  (0%Z <= r)%Z -> (0%Z < j)%Z -> (i = ((q * j)%Z + r)%Z) ->
  ((0%Z <= r)%Z /\ (r < j)%Z) ->
  (q = (int.EuclideanDivision.div i j)) /\
  (r = (int.EuclideanDivision.mod1 i j)).

Axiom decomp :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  (i =
   ((j * (int.EuclideanDivision.div i j))%Z +
    (int.EuclideanDivision.mod1 i j))%Z).

Axiom div_plus_quotient :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  ((int.EuclideanDivision.div (i + j)%Z j) =
   ((int.EuclideanDivision.div i j) + 1%Z)%Z).

Axiom div_plus_fact_gen_div :
  forall (i:Z) (j:Z) (k:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z < k)%Z ->
  ((int.EuclideanDivision.div (i + (k * j)%Z)%Z j) =
   ((int.EuclideanDivision.div i j) + k)%Z).

Axiom mod_plus_fact_gen_mod :
  forall (i:Z) (j:Z) (k:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z <= k)%Z ->
  ((int.EuclideanDivision.mod1 ((k * j)%Z + i)%Z j) =
   (int.EuclideanDivision.mod1 i j)).

Axiom bound_div :
  forall (i:Z) (q:Z) (f:Z), (0%Z <= i)%Z -> (0%Z <= q)%Z -> (0%Z <= f)%Z ->
  (i < (f * q)%Z)%Z ->
  (0%Z <= ((int.EuclideanDivision.div i q) * q)%Z)%Z /\
  ((((int.EuclideanDivision.div i q) * q)%Z <= i)%Z /\
   (i < (q * ((int.EuclideanDivision.div i q) + 1%Z)%Z)%Z)%Z).

Axiom bound_div_factor :
  forall (i:Z) (q:Z) (f:Z), (0%Z <= i)%Z -> (0%Z <= q)%Z -> (0%Z <= f)%Z ->
  (i < (f * q)%Z)%Z -> ((int.EuclideanDivision.div i q) < f)%Z.

Axiom mod_invariant :
  forall (i:Z) (q:Z) (f:Z), (0%Z <= i)%Z -> (0%Z < q)%Z -> (0%Z < f)%Z ->
  ((int.EuclideanDivision.mod1
    ((q * (f * (int.EuclideanDivision.div i (q * f)%Z))%Z)%Z +
     (int.EuclideanDivision.mod1 i (q * f)%Z))%Z
    q)
   = (int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (q * f)%Z) q)).

Axiom mod_mod :
  forall (i:Z) (j:Z) (f:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z < f)%Z ->
  ((int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (j * f)%Z) j) =
   (int.EuclideanDivision.mod1 i j)) /\
  ((int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (f * j)%Z) j) =
   (int.EuclideanDivision.mod1 i j)).

Axiom mod_mod_rev :
  forall (i:Z) (j:Z) (f:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z < f)%Z ->
  ((int.EuclideanDivision.mod1 i j) =
   (int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (j * f)%Z) j)) /\
  ((int.EuclideanDivision.mod1 i j) =
   (int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (f * j)%Z) j)).

Axiom mod_mod_plus :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  ((int.EuclideanDivision.mod1 i j) =
   (int.EuclideanDivision.mod1 (int.EuclideanDivision.mod1 i (j + j)%Z) j)).

Axiom mult_assoc :
  forall (i:Z) (q:Z) (f:Z), (0%Z <= i)%Z -> (0%Z < q)%Z -> (0%Z < f)%Z ->
  ((q * (f * (int.EuclideanDivision.div i (q * f)%Z))%Z)%Z =
   ((q * f)%Z * (int.EuclideanDivision.div i (q * f)%Z))%Z).

Axiom div_div :
  forall (i:Z) (j:Z) (k:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z < k)%Z ->
  ((int.EuclideanDivision.div (int.EuclideanDivision.div i k) j) =
   (int.EuclideanDivision.div i (k * j)%Z)) /\
  ((int.EuclideanDivision.div (int.EuclideanDivision.div i k) j) =
   (int.EuclideanDivision.div i (j * k)%Z)).

Axiom mod_div :
  forall (i:Z) (j:Z) (k:Z), (0%Z <= i)%Z -> (0%Z < j)%Z -> (0%Z < k)%Z ->
  ((int.EuclideanDivision.div (int.EuclideanDivision.mod1 i (j * k)%Z) j) =
   (int.EuclideanDivision.mod1 (int.EuclideanDivision.div i j) k)).

Axiom div_sum_exponents :
  forall (i:Z) (k:Z) (n:Z) (m:Z), (0%Z <= i)%Z -> (0%Z < k)%Z ->
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((power k (n + m)%Z) = ((power k n) * (power k m))%Z) /\
  (((power k (n + 1%Z)%Z) = ((power k n) * k)%Z) /\
   (((power k 1%Z) = k) /\
    (((int.EuclideanDivision.div (int.EuclideanDivision.div i (power k n))
       (power k m))
      = (int.EuclideanDivision.div i (power k (n + m)%Z))) /\
     ((int.EuclideanDivision.div (int.EuclideanDivision.div i (power k n)) k)
      = (int.EuclideanDivision.div i (power k (n + 1%Z)%Z)))))).

Parameter divp: Z -> Z -> Z.

Axiom divp_def :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  ((divp i j) = ((int.EuclideanDivision.div i j) * j)%Z).

Axiom divp_spec :
  forall (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z < j)%Z ->
  (i = ((divp i j) + (int.EuclideanDivision.mod1 i j))%Z) /\
  ((((divp i j) <= i)%Z /\ (i < (((divp i j) + 1%Z)%Z * j)%Z)%Z) /\
   ((j < i)%Z -> (0%Z < (divp i j))%Z)).

Parameter to_k_ary: Z -> Z -> Z -> Z.

Axiom to_k_ary_def :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (0%Z < k)%Z ->
  ((to_k_ary i k n) =
   (int.EuclideanDivision.mod1 (int.EuclideanDivision.div i (power k n)) k)).

Axiom to_k_ary_spec :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (0%Z < k)%Z ->
  (0%Z <= (to_k_ary i k n))%Z /\ ((to_k_ary i k n) < k)%Z.

Axiom to_k_ary_div_mod :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (0%Z < k)%Z ->
  ((to_k_ary i k n) =
   (int.EuclideanDivision.div
    (int.EuclideanDivision.mod1 i (power k (n + 1%Z)%Z)) (power k n))).

Parameter weighted_to_k_ary: Z -> Z -> Z -> Z.

Axiom weighted_to_k_ary_def :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (0%Z < k)%Z ->
  ((weighted_to_k_ary i k n) = ((to_k_ary i k n) * (power k n))%Z).

Axiom weighted_to_k_ary_spec :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (0%Z < k)%Z ->
  ((power k n) < i)%Z ->
  (0%Z <= (weighted_to_k_ary i k n))%Z /\ ((weighted_to_k_ary i k n) <= i)%Z.

Axiom decreasing_div :
  forall (i:Z) (k:Z) (n:Z), (0%Z <= i)%Z -> (0%Z <= n)%Z -> (1%Z < k)%Z ->
  ((power k (n + 1%Z)%Z) < i)%Z ->
  ((int.EuclideanDivision.div i (power k n)) =
   (((int.EuclideanDivision.div i (power k (n + 1%Z)%Z)) * k)%Z +
    (to_k_ary i k n))%Z) /\
  ((int.EuclideanDivision.div i (power k (n + 1%Z)%Z)) <
   (int.EuclideanDivision.div i (power k n)))%Z.

Parameter k_ary_length: Z -> Z -> Z.

Axiom k_ary_length_spec :
  forall (i:Z) (k:Z), (0%Z <= i)%Z -> (1%Z < k)%Z ->
  ((0%Z < i)%Z ->
   ((power k ((k_ary_length i k) - 1%Z)%Z) <= i)%Z /\
   (i < (power k (k_ary_length i k)))%Z) /\
  (((i < k)%Z -> ((k_ary_length i k) = 1%Z)) /\
   (1%Z <= (k_ary_length i k))%Z).

Axiom no_rest_length :
  forall (i:Z) (k:Z) (l:Z), (0%Z < i)%Z -> (0%Z <= l)%Z -> (1%Z < k)%Z ->
  (i = (power k l)) -> ((k_ary_length i k) = (l + 1%Z)%Z).

Axiom mod_k_ary :
  forall (i:Z) (k:Z) (l:Z) (j:Z), (0%Z <= i)%Z -> (1%Z < k)%Z ->
  (0%Z <= l)%Z -> ((0%Z <= j)%Z /\ (j < l)%Z) ->
  ((to_k_ary (int.EuclideanDivision.mod1 i (power k l)) k j) =
   (to_k_ary i k j)).

Axiom mod_k_ary_comm :
  forall (i:Z) (k:Z) (l:Z) (j:Z), (0%Z <= i)%Z -> (1%Z < k)%Z ->
  ((0%Z <= l)%Z /\ (l < (k_ary_length i k))%Z) ->
  ((0%Z <= j)%Z /\ (j < l)%Z) ->
  ((to_k_ary i k j) =
   (to_k_ary (int.EuclideanDivision.mod1 i (power k l)) k j)).

(* Why3 assumption *)
Definition matrix (a:Type) := Z -> Z -> a.

Parameter rows: forall {a:Type} {a_WT:WhyType a}, (Z -> Z -> a) -> Z.

Axiom rows_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (m:Z -> Z -> a), (0%Z < (rows m))%Z.

Parameter columns: forall {a:Type} {a_WT:WhyType a}, (Z -> Z -> a) -> Z.

Axiom columns_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (m:Z -> Z -> a), (0%Z < (columns m))%Z.

(* Why3 assumption *)
Definition valid_index {a:Type} {a_WT:WhyType a} (a1:Z -> Z -> a) (r:Z)
    (c:Z) : Prop :=
  ((0%Z <= r)%Z /\ (r < (rows a1))%Z) /\
  ((0%Z <= c)%Z /\ (c < (columns a1))%Z).

Parameter get:
  forall {a:Type} {a_WT:WhyType a}, (Z -> Z -> a) -> Z -> Z -> a.

Axiom get_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (a1:Z -> Z -> a) (r:Z) (c:Z), (valid_index a1 r c) ->
  ((get a1 r c) = ((a1 r) c)).

Parameter equal:
  forall {a:Type} {a_WT:WhyType a}, (Z -> Z -> a) -> (Z -> Z -> a) -> Prop.

Axiom equal_mat :
  forall {a:Type} {a_WT:WhyType a},
  forall (m:Z -> Z -> a) (n:Z -> Z -> a),
  (equal m n) <->
  forall (i:Z) (j:Z),
  ((valid_index m i j) <-> (valid_index n i j)) /\
  ((valid_index m i j) -> ((get m i j) = (get n i j))).

Parameter make: forall {a:Type} {a_WT:WhyType a}, Z -> Z -> a -> Z -> Z -> a.

Axiom make_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (r:Z) (c:Z) (v:a), ((0%Z <= r)%Z /\ (0%Z <= c)%Z) ->
  ((rows (make r c v)) = r) /\
  (((columns (make r c v)) = c) /\
   forall (i:Z) (j:Z),
   (((0%Z <= i)%Z /\ (i < r)%Z) /\ ((0%Z <= j)%Z /\ (j < c)%Z)) ->
   ((((make r c v) i) j) = v)).

Parameter set:
  forall {a:Type} {a_WT:WhyType a}, (Z -> Z -> a) -> Z -> Z -> a ->
  Z -> Z -> a.

Axiom set_def :
  forall {a:Type} {a_WT:WhyType a},
  forall (a1:Z -> Z -> a) (r:Z) (c:Z) (v:a), (valid_index a1 r c) ->
  ((set a1 r c v) = (map.Map.set a1 r (map.Map.set (a1 r) c v))).

Axiom set_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (a1:Z -> Z -> a) (r:Z) (c:Z) (v:a), (valid_index a1 r c) ->
  ((rows (set a1 r c v)) = (rows a1)) /\
  (((columns (set a1 r c v)) = (columns a1)) /\
   ((forall (i:Z) (j:Z), (valid_index a1 i j) ->
     (((i = r) /\ (j = c)) -> ((((set a1 r c v) i) j) = v)) /\
     (~ ((i = r) /\ (j = c)) -> ((((set a1 r c v) i) j) = ((a1 i) j)))) /\
    (((get (set a1 r c v) r c) = v) /\
     ((forall (i:Z) (j:Z), (valid_index (set a1 r c v) i j) -> ~ (i = r) ->
       ((get (set a1 r c v) i j) = (get a1 i j))) /\
      forall (i:Z) (j:Z), (valid_index (set a1 r c v) i j) -> ~ (j = c) ->
      ((get (set a1 r c v) i j) = (get a1 i j)))))).

Parameter infix_asdtdt: t -> t -> t.

Parameter tensor_neutral: Z -> Z -> t.

Parameter tone: t.

Axiom tensor_neutral1 : (tensor_neutral = (make 1%Z 1%Z tone)).

(* Why3 assumption *)
Definition terms := Z -> t.

Axiom factor_one_left : forall (a:t), ((infix_asdtdt tone a) = a).

Axiom factor_one_right : forall (a:t), ((infix_asdtdt a tone) = a).

Axiom factor_assoc :
  forall (a:t) (b:t) (c:t),
  ((infix_asdtdt (infix_asdtdt a b) c) = (infix_asdtdt a (infix_asdtdt b c))).

Parameter product: (Z -> t) -> Z -> Z -> t.

Axiom product_def :
  forall (f:Z -> t) (i:Z) (j:Z),
  ((j <= i)%Z -> ((product f i j) = tone)) /\
  (~ (j <= i)%Z ->
   ((product f i j) = (infix_asdtdt (f i) (product f (i + 1%Z)%Z j)))).

Axiom Product_def_empty :
  forall (f:Z -> t) (i:Z) (j:Z), (j <= i)%Z -> ((product f i j) = tone).

Axiom Product_def_non_empty :
  forall (f:Z -> t) (i:Z) (j:Z), (i < j)%Z ->
  ((product f i j) = (infix_asdtdt (f i) (product f (i + 1%Z)%Z j))).

Axiom product_right_extension :
  forall (f:Z -> t) (i:Z) (j:Z), (i < j)%Z ->
  ((product f i j) =
   (infix_asdtdt (product f i (j - 1%Z)%Z) (f (j - 1%Z)%Z))).

Axiom product_right_extension_comm :
  forall (f:Z -> t) (i:Z) (j:Z), (i < j)%Z ->
  ((infix_asdtdt (product f i (j - 1%Z)%Z) (f (j - 1%Z)%Z)) =
   (product f i j)).

Axiom product_transitivity :
  forall (f:Z -> t) (i:Z) (k:Z) (j:Z), ((i <= k)%Z /\ (k <= j)%Z) ->
  ((product f i j) = (infix_asdtdt (product f i k) (product f k j))).

Axiom product_eq :
  forall (f1:Z -> t) (f2:Z -> t) (i:Z) (j:Z),
  (forall (k:Z), ((i <= k)%Z /\ (k < j)%Z) -> ((f1 k) = (f2 k))) ->
  ((product f1 i j) = (product f2 i j)).

Parameter tensor: (Z -> Z -> t) -> (Z -> Z -> t) -> Z -> Z -> t.

Axiom tensor_spec :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t),
  ((rows (tensor m n)) = ((rows m) * (rows n))%Z) /\
  (((columns (tensor m n)) = ((columns m) * (columns n))%Z) /\
   forall (i:Z), forall (j:Z), (valid_index (tensor m n) i j) ->
   ((get (tensor m n) i j) =
    (infix_asdtdt
     (get n (int.EuclideanDivision.mod1 i (rows n))
      (int.EuclideanDivision.mod1 j (columns n)))
     (get m (int.EuclideanDivision.div i (rows n))
      (int.EuclideanDivision.div j (columns n)))))).

Parameter pow: (Z -> Z -> t) -> Z -> Z -> Z -> t.

Axiom pow_def :
  forall (m:Z -> Z -> t) (e:Z), (0%Z <= e)%Z ->
  ((e = 0%Z) -> ((pow m e) = tensor_neutral)) /\
  (~ (e = 0%Z) -> ((pow m e) = (tensor m (pow m (e - 1%Z)%Z)))).

Axiom pow_spec :
  forall (m:Z -> Z -> t) (e:Z), (0%Z <= e)%Z ->
  ((rows (pow m e)) = (power (rows m) e)) /\
  ((columns (pow m e)) = (power (columns m) e)).

Parameter get_k_th_comp: (Z -> Z -> t) -> Z -> Z -> Z -> t.

Axiom get_k_th_comp_def :
  forall (m:Z -> Z -> t) (i:Z) (j:Z) (k:Z), (0%Z <= i)%Z -> (0%Z <= j)%Z ->
  (0%Z <= k)%Z ->
  ((get_k_th_comp m i j k) =
   (get m (to_k_ary i (rows m) k) (to_k_ary j (columns m) k))).

Axiom get_k_th_comp_mod :
  forall (m:Z -> Z -> t) (i:Z) (j:Z) (k:Z) (l:Z), (0%Z <= i)%Z ->
  (0%Z <= j)%Z -> ((0%Z < k)%Z /\ (k < l)%Z) ->
  ((get m (to_k_ary i (rows m) k) (to_k_ary j (columns m) k)) =
   (get m
    (to_k_ary (int.EuclideanDivision.mod1 i (power (rows m) l)) (rows m) k)
    (to_k_ary (int.EuclideanDivision.mod1 j (power (columns m) l))
     (columns m) k))).

Axiom pow_product_pre :
  forall (m:Z -> Z -> t) (n:Z) (i:Z) (j:Z), (1%Z <= n)%Z -> (0%Z <= i)%Z ->
  (0%Z <= j)%Z -> (0%Z < n)%Z ->
  ((get (pow m n) (int.EuclideanDivision.mod1 i (rows (pow m n)))
    (int.EuclideanDivision.mod1 j (columns (pow m n))))
   =
   (infix_asdtdt
    (get (pow m (n - 1%Z)%Z)
     (int.EuclideanDivision.mod1 i (rows (pow m (n - 1%Z)%Z)))
     (int.EuclideanDivision.mod1 j (columns (pow m (n - 1%Z)%Z))))
    ((fun (k:Z) =>
      (get m
       (int.EuclideanDivision.div
        (int.EuclideanDivision.mod1 i (rows (pow m (k + 1%Z)%Z)))
        (rows (pow m k)))
       (int.EuclideanDivision.div
        (int.EuclideanDivision.mod1 j (columns (pow m (k + 1%Z)%Z)))
        (columns (pow m k)))))
     (n - 1%Z)%Z))).

Axiom pow_product_no_bound :
  forall (m:Z -> Z -> t) (n:Z) (i:Z) (j:Z), (0%Z <= n)%Z -> (0%Z <= i)%Z ->
  (0%Z <= j)%Z ->
  ((get (pow m n) (int.EuclideanDivision.mod1 i (rows (pow m n)))
    (int.EuclideanDivision.mod1 j (columns (pow m n))))
   =
   (product
    (fun (k:Z) =>
     (get m
      (int.EuclideanDivision.div
       (int.EuclideanDivision.mod1 i (rows (pow m (k + 1%Z)%Z)))
       (rows (pow m k)))
      (int.EuclideanDivision.div
       (int.EuclideanDivision.mod1 j (columns (pow m (k + 1%Z)%Z)))
       (columns (pow m k)))))
    0%Z n)).

Axiom pow_product :
  forall (m:Z -> Z -> t) (i:Z) (j:Z) (n:Z),
  ((0%Z <= i)%Z /\ (i < (power (rows m) n))%Z) ->
  ((0%Z <= j)%Z /\ (j < (power (columns m) n))%Z) -> (0%Z <= n)%Z ->
  ((get (pow m n) i j) =
   (product (fun (k:Z) => (get_k_th_comp m i j k)) 0%Z n)).

Axiom pow_product_no_bound_ :
  forall (m:Z -> Z -> t) (n:Z) (i:Z) (j:Z), (0%Z <= i)%Z -> (0%Z <= j)%Z ->
  (0%Z <= n)%Z ->
  ((get (pow m n) (int.EuclideanDivision.mod1 i (power (rows m) n))
    (int.EuclideanDivision.mod1 j (power (columns m) n)))
   = (product (fun (k:Z) => (get_k_th_comp m i j k)) 0%Z n)).

Parameter tzero: t.

Parameter tone1: t.

Parameter infix_pldtdt: t -> t -> t.

Parameter infix_sl: t -> t -> t.

Parameter modulus: t -> R.

Parameter prefix_mn: t -> t.

Axiom Assoc1 :
  forall (x:t) (y:t) (z:t),
  ((infix_pldtdt (infix_pldtdt x y) z) = (infix_pldtdt x (infix_pldtdt y z))).

Axiom Unit_def_l1 : forall (x:t), ((infix_pldtdt tzero x) = x).

Axiom Unit_def_r1 : forall (x:t), ((infix_pldtdt x tzero) = x).

Axiom Inv_def_l : forall (x:t), ((infix_pldtdt (prefix_mn x) x) = tzero).

Axiom Inv_def_r : forall (x:t), ((infix_pldtdt x (prefix_mn x)) = tzero).

Axiom Comm : forall (x:t) (y:t), ((infix_pldtdt x y) = (infix_pldtdt y x)).

Axiom Assoc2 :
  forall (x:t) (y:t) (z:t),
  ((infix_asdtdt (infix_asdtdt x y) z) = (infix_asdtdt x (infix_asdtdt y z))).

Axiom Mul_distr_l :
  forall (x:t) (y:t) (z:t),
  ((infix_asdtdt x (infix_pldtdt y z)) =
   (infix_pldtdt (infix_asdtdt x y) (infix_asdtdt x z))).

Axiom Mul_distr_r :
  forall (x:t) (y:t) (z:t),
  ((infix_asdtdt (infix_pldtdt y z) x) =
   (infix_pldtdt (infix_asdtdt y x) (infix_asdtdt z x))).

Axiom Comm1 : forall (x:t) (y:t), ((infix_asdtdt x y) = (infix_asdtdt y x)).

Axiom Unitary : forall (x:t), ((infix_asdtdt tone1 x) = x).

Axiom NonTrivialRing : ~ (tzero = tone1).

Parameter inv: t -> t.

Axiom Inverse :
  forall (x:t), ~ (x = tzero) -> ((infix_asdtdt x (inv x)) = tone1).

(* Why3 assumption *)
Definition infix_mn (x:t) (y:t) : t := infix_pldtdt x (prefix_mn y).

(* Why3 assumption *)
Definition infix_sl1 (x:t) (y:t) : t := infix_asdtdt x (inv y).

Axiom add_div :
  forall (x:t) (y:t) (z:t), ~ (z = tzero) ->
  ((infix_sl1 (infix_pldtdt x y) z) =
   (infix_pldtdt (infix_sl1 x z) (infix_sl1 y z))).

Axiom sub_div :
  forall (x:t) (y:t) (z:t), ~ (z = tzero) ->
  ((infix_sl1 (infix_mn x y) z) = (infix_mn (infix_sl1 x z) (infix_sl1 y z))).

Axiom neg_div :
  forall (x:t) (y:t), ~ (y = tzero) ->
  ((infix_sl1 (prefix_mn x) y) = (prefix_mn (infix_sl1 x y))).

Axiom assoc_mul_div :
  forall (x:t) (y:t) (z:t), ~ (z = tzero) ->
  ((infix_sl1 (infix_asdtdt x y) z) = (infix_asdtdt x (infix_sl1 y z))).

Axiom assoc_div_mul :
  forall (x:t) (y:t) (z:t), (~ (y = tzero) /\ ~ (z = tzero)) ->
  ((infix_sl1 (infix_sl1 x y) z) = (infix_sl1 x (infix_asdtdt y z))).

Axiom assoc_div_div :
  forall (x:t) (y:t) (z:t), (~ (y = tzero) /\ ~ (z = tzero)) ->
  ((infix_sl1 x (infix_sl1 y z)) = (infix_sl1 (infix_asdtdt x z) y)).

(* Why3 assumption *)
Definition terms1 := Z -> R.

Axiom add_zero_left : forall (a:R), ((0%R + a)%R = a).

Axiom add_zero_right : forall (a:R), ((a + 0%R)%R = a).

Axiom add_assoc :
  forall (a:R) (b:R) (c:R), (((a + b)%R + c)%R = (a + (b + c)%R)%R).

Parameter sum: (Z -> R) -> Z -> Z -> R.

Axiom sum_def :
  forall (f:Z -> R) (i:Z) (j:Z),
  ((j <= i)%Z -> ((sum f i j) = 0%R)) /\
  (~ (j <= i)%Z -> ((sum f i j) = ((f i) + (sum f (i + 1%Z)%Z j))%R)).

Axiom Sum_def_empty :
  forall (f:Z -> R) (i:Z) (j:Z), (j <= i)%Z -> ((sum f i j) = 0%R).

Axiom Sum_def_non_empty :
  forall (f:Z -> R) (i:Z) (j:Z), (i < j)%Z ->
  ((sum f i j) = ((f i) + (sum f (i + 1%Z)%Z j))%R).

Axiom sum_right_extension :
  forall (f:Z -> R) (i:Z) (j:Z), (i < j)%Z ->
  ((sum f i j) = ((sum f i (j - 1%Z)%Z) + (f (j - 1%Z)%Z))%R).

Axiom sum_transitivity :
  forall (f:Z -> R) (i:Z) (k:Z) (j:Z), ((i <= k)%Z /\ (k <= j)%Z) ->
  ((sum f i j) = ((sum f i k) + (sum f k j))%R).

Axiom sum_eq :
  forall (f1:Z -> R) (f2:Z -> R) (i:Z) (j:Z),
  (forall (k:Z), ((i <= k)%Z /\ (k < j)%Z) -> ((f1 k) = (f2 k))) ->
  ((sum f1 i j) = (sum f2 i j)).

Axiom absorbing_zero : forall (i:t), ((infix_asdtdt i tzero) = tzero).

Parameter is_a_q_bra: (Z -> Z -> t) -> Prop.

Axiom is_a_q_bra1 :
  forall (m:Z -> Z -> t),
  (is_a_q_bra m) <->
  (((rows m) = 1%Z) /\
   exists s:Z, (0%Z <= s)%Z /\ ((columns m) = (power 2%Z s))).

Parameter is_a_q_ket: (Z -> Z -> t) -> Prop.

Axiom is_a_q_ket1 :
  forall (m:Z -> Z -> t),
  (is_a_q_ket m) <->
  (((columns m) = 1%Z) /\
   exists s:Z, (0%Z <= s)%Z /\ ((rows m) = (power 2%Z s))).

Parameter bra_to_ket: (Z -> Z -> t) -> Z -> Z -> t.

Axiom bra_to_ket_spec :
  forall (m:Z -> Z -> t), (is_a_q_bra m) ->
  (is_a_q_ket (bra_to_ket m)) /\
  ((forall (i:Z) (j:Z),
    (valid_index m i j) <-> (valid_index (bra_to_ket m) j i)) /\
   forall (i:Z) (j:Z), (valid_index m i j) ->
   ((get m i j) = (get (bra_to_ket m) j i))).

Axiom t_binary_mult :
  forall (i:t) (j:t), ((i = tone1) \/ (i = tzero)) ->
  ((j = tone1) \/ (j = tzero)) ->
  (((i = tone1) /\ (j = tone1)) -> ((infix_asdtdt i j) = tone1)) /\
  (~ ((i = tone1) /\ (j = tone1)) -> ((infix_asdtdt i j) = tzero)).

Axiom t_binary_mult_alt :
  forall (i:t) (j:t), ((i = tone1) \/ (i = tzero)) ->
  ((j = tone1) \/ (j = tzero)) ->
  (((i = tone1) /\ (j = tone1)) -> ((infix_asdtdt i j) = tone1)) /\
  (~ ((i = tone1) /\ (j = tone1)) -> ((infix_asdtdt i j) = tzero)).

Parameter ket_to_bra: (Z -> Z -> t) -> Z -> Z -> t.

Axiom ket_to_bra_spec :
  forall (m:Z -> Z -> t), (is_a_q_ket m) ->
  (is_a_q_bra (ket_to_bra m)) /\
  ((forall (i:Z) (j:Z),
    (valid_index m i j) <-> (valid_index (ket_to_bra m) j i)) /\
   forall (i:Z) (j:Z), (valid_index m i j) ->
   ((get m i j) = (get (ket_to_bra m) j i))).

Axiom ket_to_bra_to_ket :
  forall (m:Z -> Z -> t), (is_a_q_ket m) ->
  equal (bra_to_ket (ket_to_bra m)) m.

Axiom bra_to_ket_to_bra :
  forall (m:Z -> Z -> t), (is_a_q_bra m) ->
  equal m (ket_to_bra (bra_to_ket m)).

Parameter bra_length: (Z -> Z -> t) -> Z.

Axiom bra_length_def :
  forall (m:Z -> Z -> t), (is_a_q_bra m) ->
  ((bra_length m) = ((k_ary_length (columns m) 2%Z) - 1%Z)%Z).

Axiom bra_length_spec :
  forall (m:Z -> Z -> t), (is_a_q_bra m) ->
  (0%Z <= (bra_length m))%Z /\ ((columns m) = (power 2%Z (bra_length m))).

Parameter ket_length: (Z -> Z -> t) -> Z.

Axiom ket_length_def :
  forall (m:Z -> Z -> t), (is_a_q_ket m) ->
  ((ket_length m) = ((k_ary_length (rows m) 2%Z) - 1%Z)%Z).

Axiom ket_length_spec :
  forall (m:Z -> Z -> t), (is_a_q_ket m) ->
  (0%Z <= (ket_length m))%Z /\ ((rows m) = (power 2%Z (ket_length m))).

Parameter is_a_bra: (Z -> Z -> t) -> Prop.

Axiom is_a_bra1 :
  forall (m:Z -> Z -> t),
  (is_a_bra m) <->
  ((is_a_q_bra m) /\
   ((sum (fun (k:Z) => (Reals.Rfunctions.powerRZ (modulus ((m 0%Z) k)) 2%Z))
     0%Z (columns m))
    = 1%R)).

Parameter is_a_ket: (Z -> Z -> t) -> Prop.

Axiom is_a_ket1 :
  forall (m:Z -> Z -> t),
  (is_a_ket m) <->
  ((is_a_q_ket m) /\
   ((sum (fun (k:Z) => (Reals.Rfunctions.powerRZ (modulus ((m k) 0%Z)) 2%Z))
     0%Z (rows m))
    = 1%R)).

(* Why3 assumption *)
Definition is_a_q_bra_qbit (m:Z -> Z -> t) : Prop :=
  (is_a_q_bra m) /\ ((columns m) = 2%Z).

(* Why3 assumption *)
Definition is_a_q_ket_qbit (m:Z -> Z -> t) : Prop :=
  (is_a_q_ket m) /\ ((rows m) = 2%Z).

Axiom q_bra_qbit_tensor :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t), (is_a_q_bra m) -> (is_a_q_bra n) ->
  (is_a_q_bra (tensor m n)) /\
  ((bra_length (tensor m n)) = ((bra_length m) + (bra_length n))%Z).

Axiom q_ket_qbit_tensor :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t), (is_a_q_ket m) -> (is_a_q_ket n) ->
  (is_a_q_ket (tensor m n)) /\
  ((ket_length (tensor m n)) = ((ket_length m) + (ket_length n))%Z).

(* Why3 assumption *)
Definition is_a_bra_qbit (m:Z -> Z -> t) : Prop :=
  (is_a_bra m) /\ ((columns m) = 2%Z).

(* Why3 assumption *)
Definition is_a_ket_qbit (m:Z -> Z -> t) : Prop :=
  (is_a_ket m) /\ ((rows m) = 2%Z).

Parameter int_to_bra: Z -> Z -> Z -> Z -> t.

Axiom int_to_bra_def :
  forall (i:Z) (n:Z), (0%Z <= n)%Z ->
  ((0%Z <= i)%Z /\ (i < (power 2%Z n))%Z) ->
  ((int_to_bra i n) = (set (make 1%Z (power 2%Z n) tzero) 0%Z i tone1)).

Axiom int_to_bra_spec :
  forall (i:Z) (n:Z), (0%Z <= n)%Z ->
  ((0%Z <= i)%Z /\ (i < (power 2%Z n))%Z) ->
  (is_a_q_bra (int_to_bra i n)) /\
  (((bra_length (int_to_bra i n)) = n) /\
   forall (j:Z) (k:Z), (valid_index (int_to_bra i n) j k) ->
   (((j = 0%Z) /\ (k = i)) -> ((get (int_to_bra i n) j k) = tone1)) /\
   (~ ((j = 0%Z) /\ (k = i)) -> ((get (int_to_bra i n) j k) = tzero))).

Parameter int_to_ket: Z -> Z -> Z -> Z -> t.

Axiom int_to_ket_def :
  forall (i:Z) (n:Z), (0%Z <= n)%Z ->
  ((0%Z <= i)%Z /\ (i < (power 2%Z n))%Z) ->
  ((int_to_ket i n) = (set (make (power 2%Z n) 1%Z tzero) i 0%Z tone1)).

Axiom int_to_ket_spec :
  forall (i:Z) (n:Z), (0%Z <= n)%Z ->
  ((0%Z <= i)%Z /\ (i < (power 2%Z n))%Z) ->
  (is_a_q_ket (int_to_ket i n)) /\
  (((ket_length (int_to_ket i n)) = n) /\
   forall (j:Z) (k:Z), (valid_index (int_to_ket i n) j k) ->
   (((j = i) /\ (k = 0%Z)) -> ((get (int_to_ket i n) j k) = tone1)) /\
   (~ ((j = i) /\ (k = 0%Z)) -> ((get (int_to_ket i n) j k) = tzero))).

Axiom get_int_to_bra :
  forall (i:Z) (j:Z) (k:Z) (n:Z), (0%Z <= n)%Z ->
  ((0%Z <= i)%Z /\ (i < (power 2%Z n))%Z) ->
  (valid_index (int_to_bra i n) j k) ->
  (((j = 0%Z) /\ (k = i)) -> ((get (int_to_bra i n) j k) = tone1)) /\
  (~ ((j = 0%Z) /\ (k = i)) -> ((get (int_to_bra i n) j k) = tzero)).

(* Why3 assumption *)
Definition is_a_bra_bits (m:Z -> Z -> t) : Prop :=
  exists i:Z, exists n:Z, (m = (int_to_bra i n)).

(* Why3 assumption *)
Definition is_a_ket_bits (m:Z -> Z -> t) : Prop :=
  exists i:Z, exists n:Z, (m = (int_to_ket i n)).

Parameter tensor_q_bras: (Z -> Z -> t) -> (Z -> Z -> t) -> Z -> Z -> t.

Axiom tensor_q_bras_def :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t), (is_a_q_bra m) -> (is_a_q_bra n) ->
  ((tensor_q_bras m n) = (tensor m n)).

Axiom tensor_q_bras_spec :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t), (is_a_q_bra m) -> (is_a_q_bra n) ->
  (is_a_q_bra (tensor_q_bras m n)) /\
  (((bra_length (tensor_q_bras m n)) = ((bra_length m) + (bra_length n))%Z) /\
   forall (k:Z) (l:Z), (valid_index (tensor m n) k l) ->
   ((get (tensor m n) k l) =
    (infix_asdtdt
     (get n (int.EuclideanDivision.mod1 k (rows n))
      (int.EuclideanDivision.mod1 l (columns n)))
     (get m (int.EuclideanDivision.div k (rows n))
      (int.EuclideanDivision.div l (columns n)))))).

Axiom tensor_indexes_to_left :
  forall (m:Z -> Z -> t) (n:Z -> Z -> t), (is_a_q_bra m) -> (is_a_q_bra n) ->
  forall (k:Z) (l:Z),
  (valid_index m k (int.EuclideanDivision.div l (columns n))) ->
  valid_index (tensor m n) k l.

Parameter m: Z -> Z -> t.

Parameter n: Z -> Z -> t.

Axiom H : is_a_q_bra m.

Axiom H1 : is_a_q_bra n.

Axiom H2 :
  forall (k:Z) (l:Z),
  (valid_index m k (int.EuclideanDivision.div l (columns n))) ->
  ((k = 0%Z) /\ (0%Z <= (int.EuclideanDivision.div l (columns n)))%Z) ->
  ((k = 0%Z) /\ (0%Z <= l)%Z) ->
  valid_index n k (int.EuclideanDivision.mod1 l (columns n)).

Axiom H3 :
  forall (k:Z) (l:Z),
  ((valid_index m k (int.EuclideanDivision.div l (columns n))) /\
   (valid_index n k (int.EuclideanDivision.mod1 l (columns n)))) ->
  valid_index (tensor m n) k l.

Axiom H4 :
  forall (k:Z) (l:Z), (valid_index (tensor m n) k l) ->
  (k = 0%Z) /\
  ((0%Z <= l)%Z /\ (l < (power 2%Z ((bra_length m) + (bra_length n))%Z))%Z).

Axiom H5 :
  forall (k:Z) (l:Z), (valid_index (tensor m n) k l) ->
  (k = 0%Z) /\
  ((0%Z <= l)%Z /\
   (l < ((power 2%Z (bra_length m)) * (power 2%Z (bra_length n)))%Z)%Z).

Axiom H6 :
  forall (l:Z), (valid_index (tensor m n) 0%Z l) ->
  (0%Z <= l)%Z /\
  (l < ((power 2%Z (bra_length m)) * (power 2%Z (bra_length n)))%Z)%Z.

Axiom H7 :
  forall (l:Z),
  (((int.EuclideanDivision.div l (columns n)) * (columns n))%Z <= l)%Z /\
  (l <
   (((int.EuclideanDivision.div l (columns n)) + 1%Z)%Z * (columns n))%Z)%Z.

Axiom H8 :
  forall (l:Z),
  (((int.EuclideanDivision.div l (columns n)) * (power 2%Z (bra_length n)))%Z
   <= l)%Z.

Axiom H9 :
  forall (l:Z),
  (((int.EuclideanDivision.div l (columns n)) * (power 2%Z (bra_length n)))%Z
   <= l)%Z /\
  (l < ((power 2%Z (bra_length m)) * (power 2%Z (bra_length n)))%Z)%Z.

Parameter l: Z.

(* Why3 goal *)
Theorem VC_tensor_indexes :
  ((int.EuclideanDivision.div l (columns n)) < (power 2%Z (bra_length m)))%Z.
Proof.

Qed.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.priority prosa.classic.model.suspension.
Require Import prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task
               prosa.classic.model.arrival.basic.arrival_sequence prosa.classic.model.arrival.basic.task_arrival.
Require Import prosa.classic.model.arrival.jitter.job.
Require Import prosa.classic.model.schedule.uni.schedulability prosa.classic.model.schedule.uni.service
               prosa.classic.model.schedule.uni.workload
               prosa.classic.model.schedule.uni.response_time.
Require Import prosa.classic.model.schedule.uni.jitter.schedule
               prosa.classic.model.schedule.uni.jitter.platform.
Require Import prosa.classic.model.schedule.uni.susp.suspension_intervals
               prosa.classic.model.schedule.uni.susp.schedule
               prosa.classic.model.schedule.uni.susp.valid_schedule
               prosa.classic.model.schedule.uni.susp.platform.
Require Import prosa.classic.analysis.uni.susp.dynamic.jitter.jitter_schedule
               prosa.classic.analysis.uni.susp.dynamic.jitter.jitter_schedule_properties
               prosa.classic.analysis.uni.susp.dynamic.jitter.jitter_schedule_service
               prosa.classic.analysis.uni.susp.dynamic.jitter.jitter_taskset_generation.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq fintype bigop.

(* In this file, we determine task response-time bounds in suspension-aware
   schedules using a reduction to jitter-aware schedules. *)
Module RTAByReduction.

  Import TaskArrival SporadicTaskset Suspension Priority Workload Service Schedulability
         UniprocessorScheduleWithJitter ResponseTime SuspensionIntervals ValidSuspensionAwareSchedule.

  Module susp_aware := PlatformWithSuspensions.
  Module reduction := JitterScheduleConstruction.
  Module reduction_prop := JitterScheduleProperties.
  Module reduction_serv := JitterScheduleService.
  Module ts_gen := JitterTaskSetGeneration.

  Section ComparingResponseTimeBounds.

    Context {Task: eqType}.
    Variable task_period: Task -> time.
    Variable task_deadline: Task -> time.
    Context {Job: eqType}.
    Variable job_arrival: Job -> time.
    Variable job_deadline: Job -> time.
    Variable job_task: Job -> Task.

    (** Basic Setup & Setting *)

    (* Let ts be any task set with constrained deadlines. *)
    Variable ts: seq Task.
    Hypothesis H_constrained_deadlines:
      constrained_deadline_model task_period task_deadline ts.

    (* Consider any consistent, duplicate-free job arrival sequence... *)
    Variable arr_seq: arrival_sequence Job.
    Hypothesis H_arrival_times_are_consistent:
      arrival_times_are_consistent job_arrival arr_seq.
    Hypothesis H_arrival_sequence_is_a_set: arrival_sequence_is_a_set arr_seq.

    (* ...with sporadic arrivals... *)
    Hypothesis H_sporadic_arrivals:
      sporadic_task_model task_period job_arrival job_task arr_seq.

    (* ...and in which all jobs come from task set ts. *)
    Hypothesis H_jobs_from_taskset:
      forall j, arrives_in arr_seq j -> job_task j \in ts.

    (* Since we consider real-time tasks, assume that job deadlines are equal to task deadlines. *)
    Hypothesis H_job_deadlines_equal_task_deadlines:
      forall j, arrives_in arr_seq j -> job_deadline j = task_deadline (job_task j).

    (* Consider any FP policy that is reflexive, transitive and total.
       Note that the policy does not depend on the schedule. *)
    Variable higher_eq_priority: FP_policy Task.
    Hypothesis H_priority_is_reflexive: FP_is_reflexive higher_eq_priority.
    Hypothesis H_priority_is_transitive: FP_is_transitive higher_eq_priority.
    Hypothesis H_priority_is_total: FP_is_total_over_task_set higher_eq_priority ts.
    Let job_higher_eq_priority := FP_to_JLDP job_task higher_eq_priority.

    (* Assume that jobs and tasks have associated costs... *)
    Variable job_cost: Job -> time.
    Variable task_cost: Task -> time.

    (* ...and suspension times. *)
    Variable job_suspension_duration: job_suspension Job.
    Variable task_suspension_bound: Task -> time.

    (* Assume that jobs have positive cost. *)
    Hypothesis H_positive_costs:
      forall j, arrives_in arr_seq j -> job_cost j > 0.

    (* Next, consider any valid suspension-aware schedule of this arrival sequence.
       (Note: see prosa.classic.model.schedule.uni.susp.valid_schedule.v for details) *)
    Variable sched_susp: schedule Job.
    Hypothesis H_valid_schedule:
      valid_suspension_aware_schedule job_arrival arr_seq job_higher_eq_priority
                                      job_suspension_duration job_cost sched_susp.

    (** Analysis Setup *)

    (* Now we proceed with the proof. Let tsk be the task to be analyzed. *)
    Variable tsk: Task.
    Hypothesis H_tsk_in_ts: tsk \in ts.

    (* For simplicity, let's define some local names. *)
    Let other_hep_task tsk_other :=
      higher_eq_priority tsk_other tsk && (tsk_other != tsk).
    Let task_response_time_in_sched_susp_bounded_by :=
      is_response_time_bound_of_task job_arrival job_cost job_task arr_seq sched_susp.
    Let job_response_time_in_sched_susp_bounded_by :=
      is_response_time_bound_of_job job_arrival job_cost sched_susp.
    Let completed_in_sched_susp_by := completed_by job_cost sched_susp.
    Let job_misses_no_deadline_in_sched_susp :=
      job_misses_no_deadline job_arrival job_cost job_deadline sched_susp.

    (* Assume that each task is associated a value R... *)
    Variable R: Task -> time.

    (* ...that bounds the response-time of all tasks with higher-or-equal priority
       (other than tsk) in the suspension-aware schedule sched_susp. *)
    Hypothesis H_valid_response_time_bound_of_hp_tasks:
      forall tsk_hp,
        tsk_hp \in ts ->
        other_hep_task tsk_hp ->
        task_response_time_in_sched_susp_bounded_by tsk_hp (R tsk_hp).

    (* The existence of those response-time bounds implies that we can compute the actual
       response times of the higher-priority jobs in sched_susp. *)
    Definition actual_response_time (j_hp: Job) : time :=
      [pick-min r <= R (job_task j_hp) |
         job_response_time_in_sched_susp_bounded_by j_hp r].

    (* Next, let j be any job of tsk... *)
    Variable j: Job.
    Hypothesis H_j_arrives: arrives_in arr_seq j.
    Hypothesis H_job_of_tsk: job_task j = tsk.

    (* ...and assume that all the previous jobs of same task do not miss any
       deadlines in sched_susp. *)
    Hypothesis H_no_deadline_misses_for_previous_jobs:
      forall j0,
        arrives_in arr_seq j0 ->
        job_arrival j0 < job_arrival j ->
        job_task j0 = job_task j ->
        job_misses_no_deadline_in_sched_susp j0.

    (** Instantiation of the Reduction *)

    (* First, recall the parameters of the jitter-aware task set. *)
    Let inflated_task_cost := ts_gen.inflated_task_cost task_cost task_suspension_bound tsk.
    Let task_jitter := ts_gen.task_jitter task_cost higher_eq_priority tsk.

    (* Then, using the actual response times of higher-priority jobs as parameters, we construct
       the jitter-aware schedule from sched_susp. *)
    Let sched_jitter := reduction.sched_jitter job_arrival job_task arr_seq higher_eq_priority
                        job_cost job_suspension_duration j actual_response_time.

    (* Next, recall the corresponding job parameters... *)
    Let inflated_job_cost := reduction.inflated_job_cost job_cost job_suspension_duration j.
    Let job_jitter := reduction.job_jitter job_arrival job_task higher_eq_priority job_cost j
                                           actual_response_time.

    (* ...and the definition of job response-time bound in sched_jitter. *)
    Let job_response_time_in_sched_jitter_bounded_by :=
      is_response_time_bound_of_job job_arrival inflated_job_cost sched_jitter.

    (** Central Hypothesis *)

    (* Assume that using some jitter-aware RTA, we determine that
       (R tsk) is a response-time bound for tsk in sched_jitter. *)
    Hypothesis H_valid_response_time_bound_in_sched_jitter:
      job_response_time_in_sched_jitter_bounded_by j (R tsk).

    (** **** Main Claim *)

    (* Then, we use the properties of the reduction to prove that (R tsk) is also a
       response-time bound for tsk in the original schedule sched_susp. *)
    Theorem valid_response_time_bound_in_sched_susp:
      job_response_time_in_sched_susp_bounded_by j (R tsk).
    Proof.
      rename H_priority_is_reflexive into REFL, H_priority_is_transitive into TRANS,
             H_priority_is_total into TOT, H_jobs_from_taskset into FROM,
             H_valid_response_time_bound_of_hp_tasks into RESPhp,
             H_valid_response_time_bound_in_sched_jitter into RESPj.
      rewrite -H_job_of_tsk /job_response_time_in_sched_susp_bounded_by.
      apply reduction_serv.jitter_reduction_job_j_completes_no_later with (job_task0 := job_task)
        (ts0 := ts) (arr_seq0 := arr_seq) (higher_eq_priority0 := higher_eq_priority)
        (task_period0 := task_period) (task_deadline0 := task_deadline) (job_deadline0 := job_deadline)
        (job_suspension_duration0 := job_suspension_duration) (R_hp := actual_response_time);
        try (by done).
      {
        intros j_hp ARRhp OTHERhp.
        rewrite /actual_response_time.
        apply pick_min_holds; last by intros r _ RESP _.
        exists (R (job_task j_hp)); split; first by done.
        by apply RESPhp; try (by done); [by apply FROM | rewrite /other_hep_task -H_job_of_tsk].
      }
      {
        by rewrite /is_response_time_bound_of_job H_job_of_tsk; apply RESPj.
      }
    Qed.

  End ComparingResponseTimeBounds.

End RTAByReduction.


C02W82DBHV2R:~ i847419$ coqtop
Welcome to Coq 8.8.0 (April 2018)

Coq < Require Import Classical.

Coq < Theorem exp008 : (forall P Q R J K M : Prop, ((P \/ ~Q) /\ (Q \/ ~R) /\ (R -> (J \/ K)) /\ (K -> M) /\ (M \/ P)) -> P).
1 subgoal

  ============================
  forall P Q R J K M : Prop,
  (P \/ ~ Q) /\ (Q \/ ~ R) /\ (R -> J \/ K) /\ (K -> M) /\ (M \/ P) -> P

exp008 < intros.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : (P \/ ~ Q) /\ (Q \/ ~ R) /\ (R -> J \/ K) /\ (K -> M) /\ (M \/ P)
  ============================
  P

exp008 < destruct H.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : P \/ ~ Q
  H0 : (Q \/ ~ R) /\ (R -> J \/ K) /\ (K -> M) /\ (M \/ P)
  ============================
  P

exp008 < destruct H.
2 subgoals

  P, Q, R, J, K, M : Prop
  H : P
  H0 : (Q \/ ~ R) /\ (R -> J \/ K) /\ (K -> M) /\ (M \/ P)
  ============================
  P

subgoal 2 is:
 P

exp008 < exact H.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : ~ Q
  H0 : (Q \/ ~ R) /\ (R -> J \/ K) /\ (K -> M) /\ (M \/ P)
  ============================
  P

exp008 < tauto.
Toplevel input, characters 0-5:
> tauto.
> ^^^^^
Error:
In nested Ltac calls to "tauto" and "<Coq.Init.Tauto.with_uniform_flags>",
last call failed.
Tactic failure: Classical tauto failed.

exp008 < destruct H0.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : ~ Q
  H0 : Q \/ ~ R
  H1 : (R -> J \/ K) /\ (K -> M) /\ (M \/ P)
  ============================
  P

exp008 < destruct H1.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : ~ Q
  H0 : Q \/ ~ R
  H1 : R -> J \/ K
  H2 : (K -> M) /\ (M \/ P)
  ============================
  P

exp008 < destruct H2.
1 subgoal

  P, Q, R, J, K, M : Prop
  H : ~ Q
  H0 : Q \/ ~ R
  H1 : R -> J \/ K
  H2 : K -> M
  H3 : M \/ P
  ============================
  P

exp008 < tauto.
Toplevel input, characters 0-5:
> tauto.
> ^^^^^
Error:
In nested Ltac calls to "tauto" and "<Coq.Init.Tauto.with_uniform_flags>",
last call failed.
Tactic failure: Classical tauto failed.

exp008 < right H3.
Toplevel input, characters 0-9:
> right H3.
> ^^^^^^^^^
Error: Illegal tactic application: got 1 extra argument.

exp008 < right.
Toplevel input, characters 0-5:
> right.
> ^^^^^
Error: Not an inductive product.

exp008 < destruct H3.
2 subgoals

  P, Q, R, J, K, M : Prop
  H : ~ Q
  H0 : Q \/ ~ R
  H1 : R -> J \/ K
  H2 : K -> M
  H3 : M
  ============================
  P

subgoal 2 is:
 P

exp008 < tauto.
Toplevel input, characters 0-5:
> tauto.
> ^^^^^
Error:
In nested Ltac calls to "tauto" and "<Coq.Init.Tauto.with_uniform_flags>",
last call failed.
Tactic failure: Classical tauto failed.

exp008 <