(* Copyright © 1998-2006
 * Henk Barendregt
 * Luís Cruz-Filipe
 * Herman Geuvers
 * Mariusz Giero
 * Rik van Ginneken
 * Dimitri Hendriks
 * Sébastien Hinderer
 * Bart Kirkels
 * Pierre Letouzey
 * Iris Loeb
 * Lionel Mamane
 * Milad Niqui
 * Russell O’Connor
 * Randy Pollack
 * Nickolay V. Shmyrev
 * Bas Spitters
 * Dan Synek
 * Freek Wiedijk
 * Jan Zwanenburg
 *
 * This work is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This work is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this work; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)
Require Export CoRN.algebra.CGroups.

Section Abelian_Groups.

(**
* Abelian Groups
Now we introduce commutativity and add some results.
*)

Definition is_CAbGroup (G : CGroup) := commutes (csg_op (c:=G)).

Record CAbGroup : Type :=
 {cag_crr   : CGroup;
  cag_proof :  is_CAbGroup cag_crr}.

Local Coercion cag_crr : CAbGroup >-> CGroup.

Section AbGroup_Axioms.

Variable G : CAbGroup.
(**
%\begin{convention}% Let [G] be an Abelian Group.
%\end{convention}%
*)

Lemma CAbGroup_is_CAbGroup : is_CAbGroup G.
Proof.
 elim G; auto.
Qed.

Lemma cag_commutes : commutes (csg_op (c:=G)).
Proof.
 exact CAbGroup_is_CAbGroup.
Qed.

Lemma cag_commutes_unfolded : forall x y : G, x[+]y [=] y[+]x.
Proof cag_commutes.

End AbGroup_Axioms.

Section SubCAbGroups.

(**
** Subgroups of an Abelian Group
*)
Variable G : CAbGroup.
Variable P : G -> CProp.
Variable Punit : P [0].
Variable op_pres_P : bin_op_pres_pred _ P csg_op.
Variable inv_pres_P : un_op_pres_pred _ P cg_inv.

(**
%\begin{convention}%
Let [G] be an Abelian Group and [P] be a ([CProp]-valued) predicate on [G]
that contains [Zero] and is closed under [[+]] and [[--]].
%\end{convention}%
*)

Let subcrr : CGroup := Build_SubCGroup _ _ Punit op_pres_P inv_pres_P.

Lemma isabgrp_scrr : is_CAbGroup subcrr.
Proof.
 red in |- *. intros x y. case x. case y. intros. simpl in |- *. apply cag_commutes_unfolded.
Qed.

Definition Build_SubCAbGroup : CAbGroup := Build_CAbGroup subcrr isabgrp_scrr.

End SubCAbGroups.

Section Various.
(**
** Basic properties of Abelian groups
*)
Hint Resolve cag_commutes_unfolded: algebra.

Variable G : CAbGroup.
(**
%\begin{convention}% Let [G] be an Abelian Group.
%\end{convention}%
*)

Lemma cag_op_inv : forall x y : G, [--] (x[+]y) [=] [--]x[+] [--]y.
Proof.
 intros x y.
 astepr ([--]y[+] [--]x).
 apply cg_inv_op.
Qed.

Hint Resolve cag_op_inv: algebra.

Lemma assoc_1 : forall x y z : G, x[-] (y[-]z) [=] x[-]y[+]z.
Proof.
 intros x y z; unfold cg_minus in |- *.
 astepr (x[+]([--]y[+]z)).
 Step_final (x[+]([--]y[+] [--][--]z)).
Qed.

Lemma minus_plus : forall x y z : G, x[-] (y[+]z) [=] x[-]y[-]z.
Proof.
 intros x y z.
 unfold cg_minus in |- *.
 Step_final (x[+]([--]y[+] [--]z)).
Qed.

Lemma op_lft_resp_ap : forall x y z : G, y [#] z -> x[+]y [#] x[+]z.
Proof.
 intros x y z H.
 astepl (y[+]x).
 astepr (z[+]x).
 apply op_rht_resp_ap; assumption.
Qed.

Lemma cag_ap_cancel_lft : forall x y z : G, x[+]y [#] x[+]z -> y [#] z.
Proof.
 intros x y z H.
 apply ap_symmetric_unfolded.
 apply cg_ap_cancel_rht with x.
 apply ap_symmetric_unfolded.
 astepl (x[+]y).
 astepr (x[+]z).
 auto.
Qed.

Lemma plus_cancel_ap_lft : forall x y z : G, z[+]x [#] z[+]y -> x [#] y.
Proof.
 intros x y z H.
 apply cag_ap_cancel_lft with z.
 assumption.
Qed.

End Various.

End Abelian_Groups.

#[global]
Hint Resolve cag_commutes_unfolded: algebra.
#[global]
Hint Resolve cag_op_inv assoc_1 zero_minus minus_plus op_lft_resp_ap: algebra.

Module Export coercions.
  Export CGroups.coercions.
  Coercion cag_crr : CAbGroup >-> CGroup.
End coercions.

Section Nice_Char.

(**
** Building an abelian group

In order to actually define concrete abelian groups,
it is not in general practical to construct first a semigroup,
then a monoid, then a group and finally an abelian group.  The
presence of commutativity, for example, makes many of the monoid
proofs trivial.  In this section, we provide a constructor that
will allow us to go directly from a setoid to an abelian group.

We start from a setoid S with an element [unit], a
commutative and associative binary operation [plus] which
is strongly extensional in its first argument and has [unit]
as a left unit, and a unary setoid
function [inv] which inverts elements respective to [plus].
*)

Variable S : CSetoid.
Variable unit : S.
Variable plus : S -> S -> S.
(**
%\begin{convention}%
Let [S] be a Setoid and [unit:S], [plus:S->S->S] and [inv] a unary
setoid operation on [S].
Assume that [plus] is commutative, associative and `left-strongly-extensional
([(plus x z) [#] (plus y z) -> x [#] y]), that [unit] is a left-unit
for [plus] and [(inv x)] is a right-inverse of [x] w.r.t.%\% [plus].
%\end{convention}%
*)

Hypothesis plus_lext : forall x y z : S, plus x z [#] plus y z -> x [#] y.
Hypothesis plus_lunit : forall x : S, plus unit x [=] x.
Hypothesis plus_comm : forall x y : S, plus x y [=] plus y x.
Hypothesis plus_assoc : associative plus.

Variable inv : CSetoid_un_op S.

Hypothesis inv_inv : forall x : S, plus x (inv x) [=] unit.

Lemma plus_rext : forall x y z : S, plus x y [#] plus x z -> y [#] z.
Proof.
 intros x y z H.
 apply plus_lext with x.
 astepl (plus x y).
 astepr (plus x z).
 auto.
Qed.

Lemma plus_runit : forall x : S, plus x unit [=] x.
Proof.
 intro x.
 Step_final (plus unit x).
Qed.

Lemma plus_is_fun : bin_fun_strext _ _ _ plus.
Proof.
 intros x x' y y' H.
 elim (ap_cotransitive_unfolded _ _ _ H (plus x y')); intro H'.
  right; apply plus_lext with x.
  astepl (plus x y); astepr (plus x y'); auto.
 left; eauto.
Qed.

Lemma inv_inv' : forall x : S, plus (inv x) x [=] unit.
Proof.
 intro.
 Step_final (plus x (inv x)).
Qed.

Definition plus_fun : CSetoid_bin_op S := Build_CSetoid_bin_fun _ _ _ plus plus_is_fun.

Definition Build_CSemiGroup' : CSemiGroup.
Proof.
 apply Build_CSemiGroup with S plus_fun.
 exact plus_assoc.
Defined.

Definition Build_CMonoid' : CMonoid.
Proof.
 apply Build_CMonoid with Build_CSemiGroup' unit.
 apply Build_is_CMonoid.
  exact plus_runit.
 exact plus_lunit.
Defined.

Definition Build_CGroup' : CGroup.
Proof.
 apply Build_CGroup with Build_CMonoid' inv.
 split.
  auto.
 apply inv_inv'.
Defined.

Definition Build_CAbGroup' : CAbGroup.
Proof.
 apply Build_CAbGroup with Build_CGroup'.
 exact plus_comm.
Defined.

End Nice_Char.

(** ** Iteration

For reflection the following is needed; hopefully it is also useful.
*)

Section Group_Extras.

Variable G : CAbGroup.

Fixpoint nmult (a:G) (n:nat) {struct n} : G :=
  match n with
  | O => [0]
  | S p => a[+]nmult a p
  end.

Lemma nmult_wd : forall (x y:G) (n m:nat), (x [=] y) -> n = m -> nmult x n [=] nmult y m.
Proof.
 simple induction n; intros.
  rewrite <- H0; algebra.
 rewrite <- H1; simpl in |- *; algebra.
Qed.

Lemma nmult_one : forall x:G, nmult x 1 [=] x.
Proof.
 simpl in |- *; algebra.
Qed.

Lemma nmult_Zero : forall n:nat, nmult [0] n [=] [0].
Proof.
 intro n.
 induction n.
  algebra.
 simpl in |- *; Step_final (([0]:G)[+][0]).
Qed.

Lemma nmult_plus : forall m n x, nmult x m[+]nmult x n [=] nmult x (m + n).
Proof.
 simple induction m.
  simpl in |- *; algebra.
 clear m; intro m.
 intros.
 simpl in |- *. Step_final (x[+](nmult x m[+]nmult x n)).
Qed.

Lemma nmult_mult : forall n m x, nmult (nmult x m) n [=] nmult x (m * n).
Proof.
 simple induction n.
  intro. rewrite mult_0_r. algebra.
  clear n; intros.
 simpl in |- *.
 rewrite mult_comm. simpl in |- *.
 eapply eq_transitive_unfolded.
  2: apply nmult_plus.
 rewrite mult_comm. algebra.
Qed.

Lemma nmult_inv : forall n x, nmult [--]x n [=] [--] (nmult x n).
Proof.
 intro; induction n; simpl in |- *.
  algebra.
 intros.
 Step_final ([--]x[+] [--](nmult x n)).
Qed.

Lemma nmult_plus' : forall n x y, nmult x n[+]nmult y n [=] nmult (x[+]y) n.
Proof.
 intro; induction n; simpl in |- *; intros.
  algebra.
 astepr (x[+]y[+](nmult x n[+]nmult y n)).
 astepr (x[+](y[+](nmult x n[+]nmult y n))).
 astepr (x[+](y[+]nmult x n[+]nmult y n)).
 astepr (x[+](nmult x n[+]y[+]nmult y n)).
 Step_final (x[+](nmult x n[+](y[+]nmult y n))).
Qed.

Hint Resolve nmult_wd nmult_Zero nmult_inv nmult_plus nmult_plus': algebra.

Definition zmult a z := caseZ_diff z (fun n m => nmult a n[-]nmult a m).

(*
Lemma Zeq_imp_nat_eq : forall m n:nat, m = n -> m = n.
auto.
intro m; induction m.
intro n; induction n; auto.

intro; induction n.
intro. inversion H.
intros.
rewrite (IHm n).
auto.
repeat rewrite inj_S in H.
auto with zarith.
Qed.
*)

Lemma zmult_char : forall (m n:nat) z, z = (m - n)%Z ->
 forall x, zmult x z [=] nmult x m[-]nmult x n.
Proof.
 simple induction z; intros.
   simpl in |- *.
   replace m with n. Step_final ([0]:G). auto with zarith.
    simpl in |- *.
  astepl (nmult x (nat_of_P p)).
  apply cg_cancel_rht with (nmult x n).
  astepr (nmult x m).
  astepl (nmult x (nat_of_P p + n)).
  apply nmult_wd; algebra.
  rewrite <- convert_is_POS in H.
  auto with zarith.
 simpl in |- *.
 astepl [--](nmult x (nat_of_P p)).
 unfold cg_minus in |- *.
 astepr ([--][--](nmult x m)[+] [--](nmult x n)).
 astepr [--]([--](nmult x m)[+]nmult x n).
 apply un_op_wd_unfolded.
 apply cg_cancel_lft with (nmult x m).
 astepr (nmult x m[+] [--](nmult x m)[+]nmult x n).
 astepr ([0][+]nmult x n).
 astepr (nmult x n).
 astepl (nmult x (m + nat_of_P p)).
 apply nmult_wd; algebra.
 rewrite <- min_convert_is_NEG in H.
 auto with zarith.
Qed.

Lemma zmult_wd : forall (x y:G) (n m:Z), (x [=] y) -> n = m -> zmult x n [=] zmult y m.
Proof.
 do 3 intro.
 case n; intros; inversion H0.
   algebra.
  unfold zmult in |- *.
  simpl in |- *.
  astepl (nmult x (nat_of_P p)); Step_final (nmult y (nat_of_P p)).
 simpl in |- *.
 astepl [--](nmult x (nat_of_P p)).
 Step_final [--](nmult y (nat_of_P p)).
Qed.

Lemma zmult_one : forall x:G, zmult x 1 [=] x.
Proof.
 simpl in |- *; algebra.
Qed.

Lemma zmult_min_one : forall x:G, zmult x (-1) [=] [--]x.
Proof.
 intros; simpl in |- *; Step_final ([0][-]x).
Qed.

Lemma zmult_zero : forall x:G, zmult x 0 [=] [0].
Proof.
 simpl in |- *; algebra.
Qed.

Lemma zmult_Zero : forall k:Z, zmult [0] k [=] [0].
Proof.
 intro; induction k; simpl in |- *.
   algebra.
  Step_final (([0]:G)[-][0]).
 Step_final (([0]:G)[-][0]).
Qed.

Hint Resolve zmult_zero: algebra.

Lemma zmult_plus : forall m n x, zmult x m[+]zmult x n [=] zmult x (m + n).
Proof.
 intros; case m; case n; intros.
         simpl in |- *; Step_final ([0][+]([0][-][0]):G).
        simpl in |- *; Step_final ([0][+](nmult x (nat_of_P p)[-][0])).
       simpl in |- *; Step_final ([0][+]([0][-]nmult x (nat_of_P p))).
      simpl in |- *; Step_final (nmult x (nat_of_P p)[-][0][+][0]).
     simpl in |- *.
     astepl (nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)).
     astepr (nmult x (nat_of_P (p0 + p))).
     rewrite nat_of_P_plus_morphism. apply nmult_plus.
     simpl (zmult x (Zpos p0)[+]zmult x (Zneg p)) in |- *.
    astepl (nmult x (nat_of_P p0)[+] [--](nmult x (nat_of_P p))).
    astepl (nmult x (nat_of_P p0)[-]nmult x (nat_of_P p)).
    apply eq_symmetric_unfolded; apply zmult_char with (z := (Zpos p0 + Zneg p)%Z).
    rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto.
    rewrite <- Zplus_0_r_reverse. Step_final (zmult x (Zneg p)[+][0]).
   simpl (zmult x (Zneg p0)[+]zmult x (Zpos p)) in |- *.
  astepl ([--](nmult x (nat_of_P p0))[+]nmult x (nat_of_P p)).
  astepl (nmult x (nat_of_P p)[+] [--](nmult x (nat_of_P p0))).
  astepl (nmult x (nat_of_P p)[-]nmult x (nat_of_P p0)).
  rewrite Zplus_comm.
  apply eq_symmetric_unfolded; apply zmult_char with (z := (Zpos p + Zneg p0)%Z).
  rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto.
  simpl in |- *.
 astepl ([--](nmult x (nat_of_P p0))[+] [--](nmult x (nat_of_P p))).
 astepl [--](nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)).
 astepr [--](nmult x (nat_of_P (p0 + p))).
 apply un_op_wd_unfolded.
 rewrite nat_of_P_plus_morphism. apply nmult_plus.
Qed.

Lemma zmult_mult : forall m n x, zmult (zmult x m) n [=] zmult x (m * n).
Proof.
 simple induction m; simple induction n; simpl in |- *; intros.
         Step_final ([0][-][0][+]([0]:G)).
        astepr ([0]:G). astepl (nmult ([0][-][0]) (nat_of_P p)).
        Step_final (nmult [0] (nat_of_P p)).
       astepr [--]([0]:G). astepl [--](nmult ([0][-][0]) (nat_of_P p)).
       Step_final [--](nmult [0] (nat_of_P p)).
      algebra.
     astepr (nmult x (nat_of_P (p * p0))).
     astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)[-][0]).
     astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)).
     rewrite nat_of_P_mult_morphism. apply nmult_mult.
     astepr [--](nmult x (nat_of_P (p * p0))).
    astepl ([0][-]nmult (nmult x (nat_of_P p)) (nat_of_P p0)).
    astepl [--](nmult (nmult x (nat_of_P p)) (nat_of_P p0)).
    rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. apply nmult_mult.
    algebra.
  astepr [--](nmult x (nat_of_P (p * p0))).
  astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)[-][0]).
  astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)).
  rewrite nat_of_P_mult_morphism. eapply eq_transitive_unfolded.
  apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult.
  astepr (nmult x (nat_of_P (p * p0))).
 astepr [--][--](nmult x (nat_of_P (p * p0))).
 astepl ([0][-]nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)).
 astepl [--](nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)).
 rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. eapply eq_transitive_unfolded.
 apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult.
Qed.

Lemma zmult_plus' : forall z x y, zmult x z[+]zmult y z [=] zmult (x[+]y) z.
Proof.
 intro z; pattern z in |- *.
 apply nats_Z_ind.
  intro n; case n.
   intros; simpl in |- *. Step_final (([0]:G)[+]([0][-][0])).
   clear n; intros.
  rewrite POS_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *.
  astepl (nmult x p[+]nmult y p). Step_final (nmult (x[+]y) p).
  intro n; case n.
  intros; simpl in |- *. Step_final (([0]:G)[+]([0][-][0])).
  clear n; intros.
 rewrite NEG_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *.
 astepl ([--](nmult x p)[+] [--](nmult y p)). astepr [--](nmult (x[+]y) p).
 Step_final [--](nmult x p[+]nmult y p).
Qed.

End Group_Extras.

#[global]
Hint Resolve nmult_wd nmult_one nmult_Zero nmult_plus nmult_inv nmult_mult
  nmult_plus' zmult_wd zmult_one zmult_min_one zmult_zero zmult_Zero
  zmult_plus zmult_mult zmult_plus': algebra.

Arguments nmult [G].
Arguments zmult [G].


Set Printing Universes.
Set Universe Polymorphism.
Set Primitive Projections.

Add LoadPath "../quotient".
Require Import Base.
Require Import MyEqDepDec.

(*! Contractible types *)

(* Unset Printing Notations. *)

Record contractible@{i} (T : Type@{i}) : Type@{i} := CtrMk
  { Point : T ;
    Ctr   : forall t : T, heq@{i i} t Point }.

(*! Integers for h-levels *)

Inductive hlevel :=
| minus2 : hlevel
| suc    : hlevel -> hlevel.

Definition minus1 := suc minus2.
Definition zero   := suc minus1.

Notation "-2" := (minus2) (at level 0).
Notation "-1" := (minus1) (at level 0).
Notation "0"  := (zero).

(*! is-n-Type *)

Fixpoint ishType@{i} (n : hlevel) (T : Type@{i}) : Type@{i} :=
  match n with
  | minus2 => contractible@{i} T
  | suc n  => forall x y : T, ishType@{i} n (heq@{i i} x y)
  end.

Definition hctr : forall T, contractible T -> ishType (-2) T.
  intros T h. exact h.
Defined.

Definition hsuc : forall l T, (forall x y : T, ishType l (heq x y)) -> ishType (suc l) T.
  intros l T h. simpl. exact h.
Defined.

Notation "is- N -Type" := (ishType N) (at level 80).

Definition ishProp := is-(-1)-Type.
Definition ishSet  := is-0-Type.

(*! n-Type *)

Definition hType (n : hlevel) := { T : Type | is-n-Type T }.

Notation "n -Type" := (hType n) (at level 75).

Definition hProp := (-1)-Type.
Definition hSet  := 0-Type.

(*! Resizing Rules for hType *)

Definition pi1 : hProp -> Type :=
  fun P => let (T,_) := P in T.

ON Unsafe Universes.

Section RR1.

  Universes i j.

  Record RR1 (A : Type@{i}) (h : ishProp@{i} A) : Type@{j} := { rr : A }.

End RR1.

OFF Unsafe Universes.

Arguments rr {_ _} r.

Definition box {A} {h : ishProp A} (a : A) : RR1 A h := Build_RR1 A h a.
Definition unbox {A} {h : ishProp A} (a : RR1 A h) : A := a.(rr).

Lemma box_unbox {A} {h : ishProp A} (x : RR1 A h) : heq (box (unbox x)) x.
  reflexivity.
Defined.

Lemma unbox_box {A} {h : ishProp A} (x : A) : heq (@unbox A h (box x)) x.
  reflexivity.
Defined.

Definition concat_Vp {A : Type} {x y : A} (p : heq x y) : heq (heq_trans _ _ _ p (heq_sym _ _ p)) (heq_refl _) :=
  match p with heq_refl _ => heq_refl _ end.

Definition path_contr {A} (h : contractible A) (x y : A) : heq x y :=
  heq_trans _ _ _ (Ctr _ h x) (heq_sym _ _ (Ctr _ h y)).

Lemma path2_contr (A : Type) (h : contractible A) (x y : A) (p q : heq x y) : heq p q.
  assert (K : forall (r : heq x y), heq r (path_contr h x y)).
  - intro r ; destruct r ; symmetry ; unfold path_contr ; now apply concat_Vp.
  - eapply (heq_trans _ (path_contr h x y)).
    + easy.
    + easy.
Defined.

Lemma contr_paths_contr : forall (A : Type) (h : contractible A) (x y : A), contractible (heq x y).
  intros A h x y. destruct h as [c ctr].
  refine ({| Point := (heq_trans _ _ _ (ctr x) (heq_sym _ _ (ctr y))) ; Ctr := _ |}).
  symmetry. apply path2_contr. exact {| Point := c ; Ctr := ctr |}.
Defined.

Lemma hProp_allpath (A : Type) : (forall (x y : A), heq x y) -> ishProp A.
  intros h x y.
  assert (forall x y : A, heq y x) as h'.
  - intros a b. apply h.
  - pose (C := CtrMk A x (h' x)).
    now apply contr_paths_contr.
Defined.

Lemma RR1_hProp : forall (A : Type) (h : ishProp A), ishProp (RR1 A h).
  intros A h. apply hProp_allpath. intros x y.
  destruct x as [x] ; destruct y as [y]. destruct (h x y) as [p _].
  now destruct p.
Defined.

(*! Truncation *)

Module Export Truncation.

  Private Inductive trunc (n : hlevel) (A : Type) : Type :=
  | tr : A -> trunc n A.
  Bind Scope trunc_scope with trunc.
  Arguments tr {n A} a.

  Section Foo.

    Universes i.

    Global Lemma ishType_trunc (n : hlevel) (A : Type@{i})
    : ishType@{i} n (trunc@{i} n A).
    Admitted.

  End Foo.

  Definition trunc_ind {n A}
             (P : trunc n A -> Type) {Pt : forall aa, ishType n (P aa)}
  : (forall a, P (tr a)) -> (forall aa, P aa)
    := fun f aa =>
        match aa with
            tr a => fun _ => f a
        end
          Pt.

End Truncation.
Import Truncation.

Notation "|| A ||" := (trunc minus1 A) (at level 85).

(*! Equivalence *)

Definition comp {A B C} (f : B -> C) (g : A -> B) := fun x => f (g x).
Notation "f ∘ g" := (comp f g) (at level 86).

Definition homo {A B} (f g : A -> B) := forall a : A, heq (f a) (g a).
Notation "f ~ g" := (homo f g) (at level 87).

Definition id A := fun x : A => x.

(*Inductive prod A B :=
| pair : forall (a : A) (b : B), prod A B.*)
Notation "A * B" := (prod A B).

Definition isEquiv {A B} (f : A -> B) :=
  { g : B -> A | g ∘ f ~ id A } * { h : B -> A | f ∘ h ~ id B }.

(*! Equivalence relations *)

(* Definition pi1 (T : hProp) : Type := *)
(*   let (TT, _) := T in TT. *)

Record isEqRel {A} (R : A -> A -> hProp) :=
  { rho : forall x : A, pi1 (R x x) ;
    sigma : forall x y : A, pi1 (R x y) -> pi1 (R y x) ;
    tau : forall x y z : A, pi1 (R y z) -> pi1 (R x y) -> pi1 (R x z) }.

(*! Quotient *)

Definition isEqClass {A} (R : A -> A -> hProp) (P : A -> hProp) :=
  { x : A | forall y : A,  { f : pi1 (R x y) -> pi1 (P y) | isEquiv f } }.

(*! hProp can be inverted *)
Lemma inv_hProp {T} : ishProp T -> forall a b : T, contractible (heq a b).
Proof.
  intros h a b.
  apply h.
Defined.

(*! hProp is only up to codomain *)

Lemma forall_hProp {A B} : (forall x : A, ishProp (B x)) -> ishProp (forall x, B x).
Proof.
  intro h.
  apply hsuc. intros f g.
  apply hctr.
  assert (heq f g) as f_g.
  - apply dep_fun_ext. intro a.
    pose proof (h a) as ha.
    apply ha.
  - destruct f_g.
    exists (heq_refl _). intro p.
    apply eq_proofs_unicity. intros g1 g2.
    left. apply dep_fun_ext. intro a.
    pose proof (h a) as ha.
    apply ha.
Defined.


From iris.algebra Require Export cmra local_updates proofmode_classes.
From iris Require Import options.

(** ** Natural numbers with [add] as the operation. *)
Section nat.
  Instance nat_valid : Valid nat := λ x, True.
  Instance nat_validN : ValidN nat := λ n x, True.
  Instance nat_pcore : PCore nat := λ x, Some 0.
  Instance nat_op : Op nat := plus.
  Definition nat_op_plus x y : x ⋅ y = x + y := eq_refl.
  Lemma nat_included (x y : nat) : x ≼ y ↔ x ≤ y.
  Proof. by rewrite nat_le_sum. Qed.
  Lemma nat_ra_mixin : RAMixin nat.
  Proof.
    apply ra_total_mixin; try by eauto.
    - solve_proper.
    - intros x y z. apply Nat.add_assoc.
    - intros x y. apply Nat.add_comm.
    - by exists 0.
  Qed.
  Canonical Structure natR : cmraT := discreteR nat nat_ra_mixin.

  Global Instance nat_cmra_discrete : CmraDiscrete natR.
  Proof. apply discrete_cmra_discrete. Qed.

  Instance nat_unit : Unit nat := 0.
  Lemma nat_ucmra_mixin : UcmraMixin nat.
  Proof. split; apply _ || done. Qed.
  Canonical Structure natUR : ucmraT := UcmraT nat nat_ucmra_mixin.

  Global Instance nat_cancelable (x : nat) : Cancelable x.
  Proof. by intros ???? ?%Nat.add_cancel_l. Qed.

  Lemma nat_local_update (x y x' y' : nat) :
    x + y' = x' + y → (x,y) ~l~> (x',y').
  Proof.
    intros ??; apply local_update_unital_discrete=> z _.
    compute -[minus plus]; lia.
  Qed.

  (* This one has a higher precendence than [is_op_op] so we get a [+] instead
     of an [⋅]. *)
  Global Instance nat_is_op (n1 n2 : nat) : IsOp (n1 + n2) n1 n2.
  Proof. done. Qed.
End nat.

(** ** Natural numbers with [max] as the operation. *)
Record max_nat := MaxNat { max_nat_car : nat }.

Canonical Structure max_natO := leibnizO max_nat.

Section max_nat.
  Instance max_nat_unit : Unit max_nat := MaxNat 0.
  Instance max_nat_valid : Valid max_nat := λ x, True.
  Instance max_nat_validN : ValidN max_nat := λ n x, True.
  Instance max_nat_pcore : PCore max_nat := Some.
  Instance max_nat_op : Op max_nat := λ n m, MaxNat (max_nat_car n `max` max_nat_car m).
  Definition max_nat_op_max x y : MaxNat x ⋅ MaxNat y = MaxNat (x `max` y) := eq_refl.

  Lemma max_nat_included x y : x ≼ y ↔ max_nat_car x ≤ max_nat_car y.
  Proof.
    split.
    - intros [z ->]. simpl. lia.
    - exists y. rewrite /op /max_nat_op. rewrite Nat.max_r; last lia. by destruct y.
  Qed.
  Lemma max_nat_ra_mixin : RAMixin max_nat.
  Proof.
    apply ra_total_mixin; apply _ || eauto.
    - intros [x] [y] [z]. repeat rewrite max_nat_op_max. by rewrite Nat.max_assoc.
    - intros [x] [y]. by rewrite max_nat_op_max Nat.max_comm.
    - intros [x]. by rewrite max_nat_op_max Max.max_idempotent.
  Qed.
  Canonical Structure max_natR : cmraT := discreteR max_nat max_nat_ra_mixin.

  Global Instance max_nat_cmra_discrete : CmraDiscrete max_natR.
  Proof. apply discrete_cmra_discrete. Qed.

  Lemma max_nat_ucmra_mixin : UcmraMixin max_nat.
  Proof. split; try apply _ || done. intros [x]. done. Qed.
  Canonical Structure max_natUR : ucmraT := UcmraT max_nat max_nat_ucmra_mixin.

  Global Instance max_nat_core_id (x : max_nat) : CoreId x.
  Proof. by constructor. Qed.

  Lemma max_nat_local_update (x y x' : max_nat) :
    max_nat_car x ≤ max_nat_car x' → (x,y) ~l~> (x',x').
  Proof.
    move: x y x' => [x] [y] [y'] /= ?.
    rewrite local_update_unital_discrete=> [[z]] _.
    rewrite 2!max_nat_op_max. intros [= ?].
    split; first done. apply f_equal. lia.
  Qed.

  Global Instance : IdemP (=@{max_nat}) (⋅).
  Proof. intros [x]. rewrite max_nat_op_max. apply f_equal. lia. Qed.

  Global Instance max_nat_is_op (x y : nat) :
    IsOp (MaxNat (x `max` y)) (MaxNat x) (MaxNat y).
  Proof. done. Qed.
End max_nat.

(** ** Natural numbers with [min] as the operation. *)
Record min_nat := MinNat { min_nat_car : nat }.

Canonical Structure min_natO := leibnizO min_nat.

Section min_nat.
  Instance min_nat_valid : Valid min_nat := λ x, True.
  Instance min_nat_validN : ValidN min_nat := λ n x, True.
  Instance min_nat_pcore : PCore min_nat := Some.
  Instance min_nat_op : Op min_nat := λ n m, MinNat (min_nat_car n `min` min_nat_car m).
  Definition min_nat_op_min x y : MinNat x ⋅ MinNat y = MinNat (x `min` y) := eq_refl.

  Lemma min_nat_included (x y : min_nat) : x ≼ y ↔ min_nat_car y ≤ min_nat_car x.
  Proof.
    split.
    - intros [z ->]. simpl. lia.
    - exists y. rewrite /op /min_nat_op. rewrite Nat.min_r; last lia. by destruct y.
  Qed.
  Lemma min_nat_ra_mixin : RAMixin min_nat.
  Proof.
    apply ra_total_mixin; apply _ || eauto.
    - intros [x] [y] [z]. repeat rewrite min_nat_op_min. by rewrite Nat.min_assoc.
    - intros [x] [y]. by rewrite min_nat_op_min Nat.min_comm.
    - intros [x]. by rewrite min_nat_op_min Min.min_idempotent.
  Qed.
  Canonical Structure min_natR : cmraT := discreteR min_nat min_nat_ra_mixin.

  Global Instance min_nat_cmra_discrete : CmraDiscrete min_natR.
  Proof. apply discrete_cmra_discrete. Qed.

  Global Instance min_nat_core_id (x : min_nat) : CoreId x.
  Proof. by constructor. Qed.

  Lemma min_nat_local_update (x y x' : min_nat) :
    min_nat_car x' ≤ min_nat_car x → (x,y) ~l~> (x',x').
  Proof.
    move: x y x' => [x] [y] [x'] /= ?.
    rewrite local_update_discrete. move=> [[z]|] _ /=; last done.
    rewrite 2!min_nat_op_min. intros [= ?].
    split; first done. apply f_equal. lia.
  Qed.

  Global Instance : LeftAbsorb (=) (MinNat 0) (⋅).
  Proof. done. Qed.

  Global Instance : RightAbsorb (=) (MinNat 0) (⋅).
  Proof. intros [x]. by rewrite min_nat_op_min Min.min_0_r. Qed.

  Global Instance : IdemP (=@{min_nat}) (⋅).
  Proof. intros [x]. rewrite min_nat_op_min. apply f_equal. lia. Qed.

  Global Instance min_nat_is_op (x y : nat) :
    IsOp (MinNat (x `min` y)) (MinNat x) (MinNat y).
  Proof. done. Qed.
End min_nat.

(** ** Positive integers with [Pos.add] as the operation. *)
Section positive.
  Instance pos_valid : Valid positive := λ x, True.
  Instance pos_validN : ValidN positive := λ n x, True.
  Instance pos_pcore : PCore positive := λ x, None.
  Instance pos_op : Op positive := Pos.add.
  Definition pos_op_plus x y : x ⋅ y = (x + y)%positive := eq_refl.
  Lemma pos_included (x y : positive) : x ≼ y ↔ (x < y)%positive.
  Proof. by rewrite Plt_sum. Qed.
  Lemma pos_ra_mixin : RAMixin positive.
  Proof.
    split; try by eauto.
    - by intros ??? ->.
    - intros ???. apply Pos.add_assoc.
    - intros ??. apply Pos.add_comm.
  Qed.
  Canonical Structure positiveR : cmraT := discreteR positive pos_ra_mixin.

  Global Instance pos_cmra_discrete : CmraDiscrete positiveR.
  Proof. apply discrete_cmra_discrete. Qed.

  Global Instance pos_cancelable (x : positive) : Cancelable x.
  Proof. intros n y z ??. by eapply Pos.add_reg_l, leibniz_equiv. Qed.
  Global Instance pos_id_free (x : positive) : IdFree x.
  Proof.
    intros y ??. apply (Pos.add_no_neutral x y). rewrite Pos.add_comm.
    by apply leibniz_equiv.
  Qed.

  (* This one has a higher precendence than [is_op_op] so we get a [+] instead
     of an [⋅]. *)
  Global Instance pos_is_op (x y : positive) : IsOp (x + y)%positive x y.
  Proof. done. Qed.
End positive.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.montgomery64_2e413m21_7limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition add :
  { add : feBW_small -> feBW_small -> feBW_small
  | forall a b, phiM_small (add a b) = F.add (phiM_small a) (phiM_small b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_add ().
  Show Ltac Profile.
Time Defined.

Print Assumptions add.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A Bprime L11 L12 L21 L22 : Universe, ((wd_ L11 L12 /\ (wd_ L21 L22 /\ (col_ L11 L12 A /\ (col_ L11 L12 Bprime /\ (col_ L11 L21 L22 /\ col_ L12 L21 L22))))) -> col_ L21 L22 Bprime)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Undecidability.TM Require Import ProgrammingTools.
From Undecidability Require Import CaseList WriteString Hoare.

Module Cons_constant.
Section Fix.

  Context {Σ__X: finType} {X : Type} {cX : codable Σ__X X}.

  (* Local Instance retr_X : Retract Σ__X Σ := (Retract_sigList_X _). *)

  Variable (c:X).

  Definition M : pTM (sigList Σ__X)^+ unit 1 :=
      WriteString Lmove (rev (inr sigList_cons::map (fun x => inr (sigList_X x)) ((encode c))));;
      Move Lmove;;
      Write (inl START).

  Definition Rel : pRel (sigList Σ__X)^+ unit 1 :=
    ignoreParam (
        fun tin tout =>
          forall l (s0 : nat),
            tin[@Fin0] ≃(;s0) l ->
            tout[@Fin0] ≃(;s0 - size c - 1) c :: l
    ).

  Lemma Realise : M ⊨ Rel.
  Proof.
    eapply Realise_monotone.
    { unfold M. TM_Correct. eapply RealiseIn_Realise,WriteString_Sem. }
    {
      intros tin ((), tout) H. TMSimp.
      destruct H2 as (?&->&?);cbn.
      simpl_tape.
      rewrite WriteString_L_left;cbn. autorewrite with list.
      erewrite !tape_right_move_left.
      2:{rewrite WriteString_L_current. autorewrite with list. cbn. reflexivity. }
      rewrite WriteString_L_right. cbn.
      eexists. repeat (cbn;autorewrite with list;try rewrite !map_map).
      split. reflexivity.
      rewrite tl_length,List.skipn_length. unfold size. nia.
    }
  Qed.

  Definition time {sigX} {X : Type} {cX : codable sigX X} (c:X) := 5 + 2 * size c.

  Lemma Terminates :
    projT1 M ↓
           (fun tin k =>
              exists (l: list X) ,
                tin[@Fin0] ≃ l /\
                time c<= k).
  Proof.
    unfold Constr_cons_steps. eapply TerminatesIn_monotone.
    { unfold M. TM_Correct.
      eapply RealiseIn_Realise. 2:eapply RealiseIn_TerminatesIn.
      all:apply WriteString_Sem.
    }
    {
      intros tin k (l&Hin&Hk). cbn. autorewrite with list.
      infTer 4.
      2:{
        intros. infTer 4. intros. reflexivity.
      }
      cbn. unfold time,size in Hk. nia.
    }
  Qed.

  Lemma SpecT (l:list X) ss:
    TripleT ≃≃([],withSpace [|Contains _ l|] ss) (time c) M (fun _ => ≃≃([],withSpace [|Contains _ (c::l)|] (appSize [|fun s0 => s0 - size c - 1|] ss ))).
  Proof.
    unfold withSpace in *.
    eapply Realise_TripleT. now apply Realise. now apply Terminates.
    - intros tin yout tout H HEnc. cbn in *.
      specialize (HEnc Fin0). simpl_vector in *; cbn in *. modpon H. tspec_solve.
    - intros tin k HEnc Hk. cbn in *.
      specialize (HEnc Fin0). simpl_vector in *; cbn in *. do 2 eexists. 2:assumption. contains_ext.
  Qed.

End Fix.
End Cons_constant.

Ltac hstep_Cons_constant :=
  match goal with
  | [ |- TripleT ?P ?k (Cons_constant.M _) ?Q ] => eapply Cons_constant.SpecT
  end.

Smpl Add hstep_Cons_constant : hstep_Spec.


Require Import String.
Require Import Lia.
Require Import List.
Require Import Nat.
Require Import Coq.Vectors.Vector.
Require Import Coq.Vectors.VectorEq.
Require Import Coq.Arith.Bool_nat.
Require Export Coq.Arith.Compare_dec.
Require Import Coq.Arith.EqNat.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Peano_dec.
Require Import Coq.Bool.Bool.
Require Import Coq.Logic.Classical_Prop.
Require Import Coq.Logic.Eqdep_dec.
Require Import Coq.Logic.FunctionalExtensionality.
Require Export RelationClasses.
Require Export Morphisms.
Require Import Program.
From ST Require Import EVarsScratchwork.
From ST Require Import Vector.
From ST Require Export Logic.V Logic.Term.
From ST Require Export SoftType.Radix SoftType.Attribute SoftType.Adjective SoftType.SoftType.
Import ListNotations.
Import VectorNotations.
Open Scope string_scope.

(** ** Judgement Types *)

Inductive JudgementType :=
| CorrectContext : JudgementType
| Esti : Term -> SoftType -> JudgementType
| Subtype : SoftType -> SoftType -> JudgementType
| Inhabited : SoftType -> JudgementType
| HasAttribute : Attribute -> SoftType -> JudgementType.

Global Instance substJudgementType : Subst JudgementType := {
  subst (x : V) (t : Term) (J : JudgementType) :=
  match J with
  | CorrectContext => J
  | Esti tm Tp => Esti (subst x t tm) (subst x t Tp)
  | Subtype T1 T2 => Subtype (subst x t T1) (subst x t T2)
  | Inhabited T => Inhabited (subst x t T)
  | HasAttribute a T => HasAttribute (subst x t a) (subst x t T)
  end
}.

Global Instance liftJudgementType : Lift JudgementType := {
  lift (c d : nat) (J : JudgementType) :=
  match J with
  | CorrectContext => J
  | Esti tm Tp => Esti (lift c d tm) (lift c d Tp)
  | Subtype T1 T2 => Subtype (lift c d T1) (lift c d T2)
  | Inhabited T => Inhabited (lift c d T)
  | HasAttribute a T => HasAttribute (lift c d a) (lift c d T)
  end;
  unlift (c d : nat) (J : JudgementType) :=
  match J with
  | CorrectContext => J
  | Esti tm Tp => Esti (unlift c d tm) (unlift c d Tp)
  | Subtype T1 T2 => Subtype (unlift c d T1) (unlift c d T2)
  | Inhabited T => Inhabited (unlift c d T)
  | HasAttribute a T => HasAttribute (unlift c d a) (unlift c d T)
  end
}.

Global Instance EnumerateEVarsJudgementType : EnumerateEVars JudgementType := {
list_evars Judg := match Judg with
| CorrectContext => []%list
| Esti t T => insert_merge (list_evars t) (list_evars T)
| Subtype T1 T2 => insert_merge (list_evars T1) (list_evars T2)
| Inhabited T => list_evars T
| HasAttribute a T => insert_merge (list_evars a) (list_evars T)
end
}.

Theorem list_evars_judgement_type_sorted : forall (j : JudgementType),
  sorted (list_evars j).
Proof.
  intros. induction j.
  - unfold list_evars; unfold EnumerateEVarsJudgementType. apply sorted_nil.
  - unfold list_evars; unfold EnumerateEVarsJudgementType.
    assert (sorted (list_evars s)). { apply list_evars_soft_type_sorted. }
    apply insert_merge_sorted2. assumption.
  - unfold list_evars; unfold EnumerateEVarsJudgementType.
    assert (sorted (list_evars s0)). { apply list_evars_soft_type_sorted. }
    apply insert_merge_sorted2. assumption.
  - unfold list_evars; unfold EnumerateEVarsJudgementType.
    assert (sorted (list_evars s)). { apply list_evars_soft_type_sorted. }
    assumption.
  - unfold list_evars; unfold EnumerateEVarsJudgementType.
    assert (sorted (list_evars s)). { apply list_evars_soft_type_sorted. }
    apply insert_merge_sorted2. assumption.
Qed.


(**************************************************************************)
(*   Mechanised Framework for Local Interactions & Distributed Algorithms *)
(*   T. Balabonski, P. Courtieu, L. Rieg, X. Urbain                       *)
(*   PACTOLE project                                                      *)
(*                                                                        *)
(*   This file is distributed under the terms of the CeCILL-C licence     *)
(*                                                                        *)
(**************************************************************************)

(**************************************************************************)
(**   Mechanised Framework for Local Interactions & Distributed Algorithms

   T. Balabonski, P. Courtieu, L. Rieg, X. Urbain

   PACTOLE project

   This file is distributed under the terms of the CeCILL-C licence
                                                                          *)
(**************************************************************************)

Require Import Relations.
Require Import Morphisms.
Require Import SetoidDec.
Require Import RelationClasses.
Require Import Pactole.Util.Coqlib.
Set Implicit Arguments.

(* Replacement to the standard library on streams. *)

Section Streams.

Context {A : Type}.
Context `{Setoid A}.

CoInductive t A : Type := cons : A -> t A -> t A.

Definition hd (s : t A) := match s with | cons e _ => e end.
Definition tl (s : t A) := match s with | cons _ s' => s' end.

Lemma stream_eq s : s = cons (hd s) (tl s).
Proof using . now destruct s. Qed.

CoFixpoint constant (c : A) := cons c (constant c).

CoFixpoint alternate (c1 c2 : A) := cons c1 (cons c2 (alternate c1 c2)).

(** **  Operators over streams  **)

(** Logical operators on properties over streams. *)

Definition instant (P : A -> Prop) := fun s => P (hd s).
Global Arguments instant P s /.

CoInductive forever (P : t A -> Prop) (s : t A) : Prop :=
  Always : P s -> forever P (tl s) -> forever P s.
Global Arguments Always [P] [s] _ _.

Inductive eventually (P : t A -> Prop) (s : t A) : Prop :=
  | Now : P s -> eventually P s
  | Later : eventually P (tl s) -> eventually P s.
Global Arguments Now [P] [s] _.
Global Arguments Later [P] [s] _.

(** Logical operators on relations over streams. *)

Definition instant2 (P : A -> A -> Prop) := fun s1 s2 => P (hd s1) (hd s2).
Global Arguments instant2 P s1 s2 /.

CoInductive forever2 (P : t A -> t A -> Prop) (s1 s2 : t A) : Prop :=
  Always2 : P s1 s2 -> forever2 P (tl s1) (tl s2) -> forever2 P s1 s2.
Global Arguments Always2 [P] [s1] [s2] _ _.

Inductive eventually2 (P : t A -> t A -> Prop) (s1 s2 : t A) : Prop :=
  | Now2 : P s1 s2 -> eventually2 P s1 s2
  | Later2 : eventually2 P (tl s1) (tl s2) -> eventually2 P s1 s2.
Global Arguments Now2 [P] [s1] [s2] _.
Global Arguments Later2 [P] [s1] [s2] _.

(** Extensional equality on streams, up to a setoid equality on the stream elements. *)
Global Instance stream_Setoid : Setoid (t A).
Proof.
exists (forever2 (instant2 equiv)). split.
+ coinduction Heq. simpl. reflexivity.
+ coinduction Heq; simpl.
  - symmetry. match goal with H : forever2 _ _ _ |- _ => now inv H end.
  - match goal with H : forever2 _ _ _ |- _ => now inv H end.
+ coinduction Heq; simpl.
  - transitivity (hd y); match goal with H : forever2 _ _ _ |- _ => now inv H end.
  - transitivity (tl y); match goal with H : forever2 _ _ _ |- _ => now inv H end.
Defined.

(** Some sanity check on [constant] and [alternate]. *)
Lemma constant_hd : forall c : A, hd (constant c) = c.
Proof using . reflexivity. Qed.

Lemma constant_tl : forall c : A, tl (constant c) = constant c.
Proof using . reflexivity. Qed.

Lemma alternate_tl_tl : forall c1 c2 : A, tl (tl (alternate c1 c2)) = alternate c1 c2.
Proof using . reflexivity. Qed.

Lemma alternate_hd : forall c1 c2 : A, hd (alternate c1 c2) = c1.
Proof using . reflexivity. Qed.

Lemma alternate_tl_hd : forall c1 c2 : A, hd (tl (alternate c1 c2)) = c2.
Proof using . reflexivity. Qed.

(** Alternative caracterisation of [alternate]. *)
Lemma alternate_tl : forall c1 c2 : A, tl (alternate c1 c2) == alternate c2 c1.
Proof using . cofix alt. constructor; [| constructor]; simpl; try reflexivity; []. apply alt. Qed.

(** Compatibility lemmas. *)

Global Instance hd_compat : Proper (equiv ==> equiv) hd.
Proof using . intros s s' Hs. now inv Hs. Qed.

Global Instance tl_compat : Proper (equiv ==> equiv) tl.
Proof using . intros s s' Hs. now inv Hs. Qed.

Global Instance constant_compat : Proper (equiv ==> equiv) constant.
Proof using . unfold constant. now coinduction Heq. Qed.

Global Instance aternate_compat : Proper (@equiv A _ ==> equiv ==> equiv) alternate.
Proof using . cofix Heq. do 2 (constructor; trivial). cbn. now apply Heq. Qed.

Global Instance instant_compat : Proper ((equiv ==> iff) ==> equiv ==> iff) instant.
Proof using . intros P Q HPQ s s' Hs. unfold instant. apply HPQ, Hs. Qed.

Global Instance forever_compat : Proper ((equiv ==> iff) ==> equiv ==> iff) forever.
Proof using .
intros P Q HPQ s s' Hs. split.
+ revert s s' Hs. coinduction Hrec.
  - rewrite <- (HPQ _ _ Hs). match goal with H : forever _ _ |- _ => now inv H end.
  - inv Hs. match goal with H : forever _ _ |- _ => inv H end. eapply Hrec; eassumption.
+ revert s s' Hs. coinduction Hrec.
  - rewrite (HPQ _ _ Hs). match goal with H : forever _ _ |- _ => now inv H end.
  - inv Hs. match goal with H : forever _ _ |- _ => inv H end. eapply Hrec; eassumption.
Qed.

Global Instance eventually_compat : Proper ((equiv ==> iff) ==> equiv ==> iff) eventually.
Proof using .
intros P Q HPQ s s' Hs. split; intro eventually.
+ revert s' Hs. induction eventually; intros s' Hs.
  - apply Now. now rewrite <- (HPQ _ _ Hs).
  - apply Later. apply IHeventually. now inv Hs.
+ revert s Hs. induction eventually; intros s' Hs.
  - apply Now. now rewrite (HPQ _ _ Hs).
  - apply Later. apply IHeventually. now inv Hs.
Qed.

Global Instance instant2_compat : Proper ((equiv ==> equiv ==> iff) ==> equiv ==> equiv ==> iff) instant2.
Proof using . intros P Q HPQ ? ? Hs1 ? ? Hs2. unfold instant2. apply HPQ; apply Hs1 || apply Hs2. Qed.

Global Instance forever2_compat : Proper ((equiv ==> equiv ==> iff) ==> equiv ==> equiv ==> iff) forever2.
Proof using .
intros P Q HPQ s1 s1' Hs1 s2 s2' Hs2. split.
+ revert s1 s1' Hs1 s2 s2' Hs2. coinduction Hrec.
  - rewrite <- (HPQ _ _ Hs1 _ _ Hs2). match goal with H : forever2 _ _ _ |- _ => now inv H end.
  - inv Hs1. inv Hs2. match goal with H : forever2 P _ _ |- _ => inv H end. eapply Hrec; eassumption.
+ revert s1 s1' Hs1 s2 s2' Hs2. coinduction Hrec.
  - rewrite (HPQ _ _ Hs1 _ _ Hs2). match goal with H : forever2 _ _ _ |- _ => now inv H end.
  - inv Hs1. inv Hs2. match goal with H : forever2 Q _ _ |- _ => inv H end. eapply Hrec; eassumption.
Qed.

Global Instance eventually2_compat : Proper ((equiv ==> equiv ==> iff) ==> equiv ==> equiv ==> iff) eventually2.
Proof using .
intros P Q HPQ s1 s1' Hs1 s2 s2' Hs2. split; intro eventually2.
+ revert s1' s2' Hs1 Hs2. induction eventually2; intros s1' s2' Hs1 Hs2.
  - apply Now2. now rewrite <- (HPQ _ _ Hs1 _ _ Hs2).
  - apply Later2. inv Hs1. inv Hs2. now apply IHeventually2.
+ revert s1 s2 Hs1 Hs2. induction eventually2; intros s1' s2' Hs1 Hs2.
  - apply Now2. now rewrite (HPQ _ _ Hs1 _ _ Hs2).
  - apply Later2. inv Hs1. inv Hs2. now apply IHeventually2.
Qed.

Lemma instant_impl_compat : forall P Q : A -> Prop,
  (forall s, P s -> Q s) -> forall s, instant P s -> instant Q s.
Proof using . unfold instant. auto. Qed.

Lemma forever_impl_compat : forall P Q : t A -> Prop,
  (forall s, P s -> Q s) -> forall s, forever P s -> forever Q s.
Proof using .
cofix Hrec. intros P Q HPQ s HP. constructor.
- inv HP. auto.
- inv HP. eapply Hrec; eauto.
Qed.

Lemma eventually_impl_compat : forall P Q : t A -> Prop,
  (forall s, P s -> Q s) -> forall s, eventually P s -> eventually Q s.
Proof using .
intros P Q HPQ s HP. induction HP as [e HP | HP].
- apply Now. auto.
- now apply Later.
Qed.

Lemma instant2_impl_compat : forall P Q : A -> A -> Prop,
  (forall s1 s2, P s1 s2 -> Q s1 s2) -> forall s1 s2, instant2 P s1 s2 -> instant2 Q s1 s2.
Proof using . unfold instant2. auto. Qed.

Lemma forever2_impl_compat : forall P Q : t A -> t A -> Prop,
  (forall s1 s2, P s1 s2 -> Q s1 s2) -> forall s1 s2, forever2 P s1 s2 -> forever2 Q s1 s2.
Proof using .
cofix Hrec. intros P Q HPQ s1 s2 HP. constructor.
- inv HP. auto.
- inv HP. eapply Hrec; eauto.
Qed.

Lemma eventually2_impl_compat : forall P Q : t A -> t A -> Prop,
  (forall s1 s2, P s1 s2 -> Q s1 s2) -> forall s1 s2, eventually2 P s1 s2 -> eventually2 Q s1 s2.
Proof using .
intros P Q HPQ s1 s2 HP. induction HP as [e1 e2 HP | HP].
- apply Now2. auto.
- now apply Later2.
Qed.

(** Relation properties lifted to steams. *)

Global Instance instant2_refl R `{Reflexive _ R} : Reflexive (instant2 R).
Proof using . intro. simpl. reflexivity. Qed.

Global Instance instant2_sym R `{Symmetric _ R} : Symmetric (instant2 R).
Proof using . intros x y HR. simpl in *. now symmetry. Qed.

Global Instance instant2_trans R `{Transitive _ R} : Transitive (instant2 R).
Proof using . intros x y z ? ?. simpl in *. now transitivity (hd y). Qed.

Global Instance forever2_refl R `{Reflexive _ R} : Reflexive (forever2 R).
Proof using . coinduction Hrec. reflexivity. Qed.

Global Instance forever2_sym R `{Symmetric _ R} : Symmetric (forever2 R).
Proof using .
coinduction Hrec; match goal with H : forever2 _ _ _ |- _ => inv H end.
- now symmetry.
- assumption.
Qed.

Global Instance forever2_trans R `{Transitive _ R} : Transitive (forever2 R).
Proof using .
coinduction Hrec; match goal with H : forever2 _ _ _, H' : forever2 _ _ _ |- _ => inv H; inv H' end.
- now transitivity y.
- now transitivity (tl y).
Qed.

Global Instance eventually2_refl R `{Reflexive _ R} : Reflexive (eventually2 R).
Proof using . intro x. apply Now2. reflexivity. Qed.

Global Instance eventually2_sym R `{Symmetric _ R} : Symmetric (eventually2 R).
Proof using .
intros x y HR. induction HR.
- apply Now2. now symmetry.
- now apply Later2.
Qed.

(* It does not apprear to be transitive for lack of synchronisation of the streams. *)
Instance eventually2_trans R `{Transitive _ R} : Transitive (eventually2 R).
Proof. Abort.

Inductive until (P Q : t A -> Prop) (s : t A) : Prop :=
  | NotYet : P s -> until P Q (tl s) -> until P Q s
  | YesNow : Q s -> until P Q s.

Definition weak_until P Q s := forever P s \/ until P Q s.
End Streams.

(** Map on streams *)
Section Map.
Context {A B : Type}.

CoFixpoint map (f : A -> B) (s : t A) := cons (f (hd s)) (map f (tl s)).

Global Instance map_compat `{Setoid A} `{Setoid B} : Proper ((equiv ==> equiv) ==> equiv ==> equiv) map.
Proof using .
intros f g Hfg. hnf. simpl. cofix Hcorec. intros s1 s2 Hs. constructor; simpl.
- apply Hfg, Hs.
- apply Hcorec, Hs.
Qed.

Lemma map_cons : forall f x s, map f (cons x s) = cons (f x) (map f s).
Proof using . intros. apply stream_eq. Qed.

Lemma map_hd : forall f s, hd (map f s) = f (hd s).
Proof using . intros. now rewrite (stream_eq s). Qed.

Lemma map_tl : forall f s, map f (tl s) = tl (map f s).
Proof using . intros. now rewrite (stream_eq s). Qed.
End Map.


(** * HoareAsLogic: Hoare Logic as a Logic *)

(** The presentation of Hoare logic in chapter [Hoare] could be
    described as "model-theoretic": the proof rules for each of the
    constructors were presented as _theorems_ about the evaluation
    behavior of programs, and proofs of program correctness (validity
    of Hoare triples) were constructed by combining these theorems
    directly in Coq.

    Another way of presenting Hoare logic is to define a completely
    separate proof system -- a set of axioms and inference rules that
    talk about commands, Hoare triples, etc. -- and then say that a
    proof of a Hoare triple is a valid derivation in _that_ logic.  We
    can do this by giving an inductive definition of _valid
    derivations_ in this new logic.

    This chapter is optional.  Before reading it, you'll want to read
    the [ProofObjects] chapter. *)

Require Import Imp.
Require Import Hoare.

(* ################################################################# *)
(** * Definitions *)

Inductive hoare_proof : Assertion -> com -> Assertion -> Type :=
  | H_Skip : forall P,
      hoare_proof P (SKIP) P
  | H_Asgn : forall Q V a,
      hoare_proof (assn_sub V a Q) (V ::= a) Q
  | H_Seq  : forall P c Q d R,
      hoare_proof P c Q -> hoare_proof Q d R -> hoare_proof P (c;;d) R
  | H_If : forall P Q b c1 c2,
    hoare_proof (fun st => P st /\ bassn b st) c1 Q ->
    hoare_proof (fun st => P st /\ ~(bassn b st)) c2 Q ->
    hoare_proof P (IFB b THEN c1 ELSE c2 FI) Q
  | H_While : forall P b c,
    hoare_proof (fun st => P st /\ bassn b st) c P ->
    hoare_proof P (WHILE b DO c END) (fun st => P st /\ ~ (bassn b st))
  | H_Consequence  : forall (P Q P' Q' : Assertion) c,
    hoare_proof P' c Q' ->
    (forall st, P st -> P' st) ->
    (forall st, Q' st -> Q st) ->
    hoare_proof P c Q.

(** We don't need to include axioms corresponding to
    [hoare_consequence_pre] or [hoare_consequence_post], because
    these can be proven easily from [H_Consequence]. *)

Lemma H_Consequence_pre : forall (P Q P': Assertion) c,
    hoare_proof P' c Q ->
    (forall st, P st -> P' st) ->
    hoare_proof P c Q.
Proof.
  intros. eapply H_Consequence.
    apply X.  apply H.  intros. apply H0. Qed.

Lemma H_Consequence_post  : forall (P Q Q' : Assertion) c,
    hoare_proof P c Q' ->
    (forall st, Q' st -> Q st) ->
    hoare_proof P c Q.
Proof.
  intros. eapply H_Consequence.
    apply X. intros. apply H0.  apply H. Qed.

(** As an example, let's construct a proof object representing a
    derivation for the hoare triple

      {{assn_sub X (X+1) (assn_sub X (X+2) (X=3))}}
      X::=X+1 ;; X::=X+2
      {{X=3}}.

    We can use Coq's tactics to help us construct the proof object. *)

Example sample_proof :
  hoare_proof
    (assn_sub X (APlus (AId X) (ANum 1))
              (assn_sub X (APlus (AId X) (ANum 2))
                        (fun st => st X = 3) ))
    (X ::= APlus (AId X) (ANum 1);; (X ::= APlus (AId X) (ANum 2)))
    (fun st => st X = 3).
Proof.
  eapply H_Seq; apply H_Asgn.
Qed.

(*
Print sample_proof.
====>
  H_Seq
    (assn_sub X (APlus (AId X) (ANum 1))
       (assn_sub X (APlus (AId X) (ANum 2))
                (fun st : state => st X = VNat 3)))
    (X ::= APlus (AId X) (ANum 1))
    (assn_sub X (APlus (AId X) (ANum 2))
              (fun st : state => st X = VNat 3))
    (X ::= APlus (AId X) (ANum 2))
      (fun st : state => st X = VNat 3)
    (H_Asgn
       (assn_sub X (APlus (AId X) (ANum 2))
                   (fun st : state => st X = VNat 3))
       X (APlus (AId X) (ANum 1)))
    (H_Asgn (fun st : state => st X = VNat 3) X
            (APlus (AId X) (ANum 2)))
*)

(* ################################################################# *)
(** * Properties *)

(** **** Exercise: 2 stars (hoare_proof_sound)  *)
(** Prove that such proof objects represent true claims. *)

Theorem hoare_proof_sound : forall P c Q,
  hoare_proof P c Q -> {{P}} c {{Q}}.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** We can also use Coq's reasoning facilities to prove metatheorems
    about Hoare Logic.  For example, here are the analogs of two
    theorems we saw in chapter [Hoare] -- this time expressed in terms
    of the syntax of Hoare Logic derivations (provability) rather than
    directly in terms of the semantics of Hoare triples.

    The first one says that, for every [P] and [c], the assertion
    [{{P}} c {{True}}] is _provable_ in Hoare Logic.  Note that the
    proof is more complex than the semantic proof in [Hoare]: we
    actually need to perform an induction over the structure of the
    command [c]. *)

Theorem H_Post_True_deriv:
  forall c P, hoare_proof P c (fun _ => True).
Proof.
  intro c.
  induction c; intro P.
  - (* SKIP *)
    eapply H_Consequence.
    apply H_Skip.
    intros. apply H.
    (* Proof of True *)
    intros. apply I.
  - (* ::= *)
    eapply H_Consequence_pre.
    apply H_Asgn.
    intros. apply I.
  - (* ;; *)
    eapply H_Consequence_pre.
    eapply H_Seq.
    apply (IHc1 (fun _ => True)).
    apply IHc2.
    intros. apply I.
  - (* IFB *)
    apply H_Consequence_pre with (fun _ => True).
    apply H_If.
    apply IHc1.
    apply IHc2.
    intros. apply I.
  - (* WHILE *)
    eapply H_Consequence.
    eapply H_While.
    eapply IHc.
    intros; apply I.
    intros; apply I.
Qed.

(** Similarly, we can show that [{{False}} c {{Q}}] is provable for
    any [c] and [Q]. *)

Lemma False_and_P_imp: forall P Q,
  False /\ P -> Q.
Proof.
  intros P Q [CONTRA HP].
  destruct CONTRA.
Qed.

Tactic Notation "pre_false_helper" constr(CONSTR) :=
  eapply H_Consequence_pre;
    [eapply CONSTR | intros ? CONTRA; destruct CONTRA].

Theorem H_Pre_False_deriv:
  forall c Q, hoare_proof (fun _ => False) c Q.
Proof.
  intros c.
  induction c; intro Q.
  - (* SKIP *) pre_false_helper H_Skip.
  - (* ::= *) pre_false_helper H_Asgn.
  - (* ;; *) pre_false_helper H_Seq. apply IHc1. apply IHc2.
  - (* IFB *)
    apply H_If; eapply H_Consequence_pre.
    apply IHc1. intro. eapply False_and_P_imp.
    apply IHc2. intro. eapply False_and_P_imp.
  - (* WHILE *)
    eapply H_Consequence_post.
    eapply H_While.
    eapply H_Consequence_pre.
      apply IHc.
      intro. eapply False_and_P_imp.
    intro. simpl. eapply False_and_P_imp.
Qed.

(** As a last step, we can show that the set of [hoare_proof] axioms
    is sufficient to prove any true fact about (partial) correctness.
    More precisely, any semantic Hoare triple that we can prove can
    also be proved from these axioms.  Such a set of axioms is said to
    be _relatively complete_.  Our proof is inspired by this one:

      http://www.ps.uni-saarland.de/courses/sem-ws11/script/Hoare.html

    To carry out the proof, we need to invent some intermediate
    assertions using a technical device known as _weakest
    preconditions_.  Given a command [c] and a desired postcondition
    assertion [Q], the weakest precondition [wp c Q] is an assertion
    [P] such that [{{P}} c {{Q}}] holds, and moreover, for any other
    assertion [P'], if [{{P'}} c {{Q}}] holds then [P' -> P].  We can
    more directly define this as follows: *)

Definition wp (c:com) (Q:Assertion) : Assertion :=
  fun s => forall s', c / s \\ s' -> Q s'.

(** **** Exercise: 1 star (wp_is_precondition)  *)

Lemma wp_is_precondition: forall c Q,
  {{wp c Q}} c {{Q}}.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (wp_is_weakest)  *)

Lemma wp_is_weakest: forall c Q P',
   {{P'}} c {{Q}} -> forall st, P' st -> wp c Q st.
(* FILL IN HERE *) Admitted.

(** The following utility lemma will also be useful. *)

Lemma bassn_eval_false : forall b st, ~ bassn b st -> beval st b = false.
Proof.
  intros b st H. unfold bassn in H. destruct (beval st b).
    exfalso. apply H. reflexivity.
    reflexivity.
Qed.
(** [] *)

(** **** Exercise: 5 stars (hoare_proof_complete)  *)
(** Complete the proof of the theorem. *)

Theorem hoare_proof_complete: forall P c Q,
  {{P}} c {{Q}} -> hoare_proof P c Q.
Proof.
  intros P c. generalize dependent P.
  induction c; intros P Q HT.
  - (* SKIP *)
    eapply H_Consequence.
     eapply H_Skip.
      intros.  eassumption.
      intro st. apply HT.  apply E_Skip.
  - (* ::= *)
    eapply H_Consequence.
      eapply H_Asgn.
      intro st. apply HT. econstructor. reflexivity.
      intros; assumption.
  - (* ;; *)
    apply H_Seq with (wp c2 Q).
     eapply IHc1.
       intros st st' E1 H. unfold wp. intros st'' E2.
         eapply HT. econstructor; eassumption. assumption.
     eapply IHc2. intros st st' E1 H. apply H; assumption.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Finally, we might hope that our axiomatic Hoare logic is
    _decidable_; that is, that there is an (terminating) algorithm (a
    _decision procedure_) that can determine whether or not a given
    Hoare triple is valid (derivable).  But such a decision procedure
    cannot exist!

    Consider the triple [{{True}} c {{False}}]. This triple is valid
    if and only if [c] is non-terminating.  So any algorithm that
    could determine validity of arbitrary triples could solve the
    Halting Problem.

    Similarly, the triple [{{True} SKIP {{P}}] is valid if and only if
    [forall s, P s] is valid, where [P] is an arbitrary assertion of
    Coq's logic. But it is known that there can be no decision
    procedure for this logic.

    Overall, this axiomatic style of presentation gives a clearer
    picture of what it means to "give a proof in Hoare logic."
    However, it is not entirely satisfactory from the point of view of
    writing down such proofs in practice: it is quite verbose.  The
    section of chapter [Hoare2] on formalizing decorated programs
    shows how we can do even better. *)

(** $Date: 2016-05-26 16:17:19 -0400 (Thu, 26 May 2016) $ *)


Require Import SyntaxExpr.

(* The depth of stack actually used by compileExpr *)
Fixpoint depth expr :=
  match expr with
    | Var _ => 0
    | Const _ => 0
    | Binop _ a b => max (depth a) (S (depth b))
    | TestE _ a b => max (depth a) (S (depth b))
  end.


Require Import Bool Arith List Bool.
Import ListNotations.

(** Generic boolean equalities (via Coq Classes) *)

Delimit Scope eqb_scope with eqb.
Local Open Scope eqb_scope.

Class Eqb (A : Type) := eqb : A -> A -> bool.
Infix "=?" := eqb : eqb_scope.
Arguments eqb {A} {_} !_ !_.

Class EqbSpec A `{Eqb A} :=
 eqbspec : forall x y:A, reflect (x=y) (x =? y).

Hint Extern 10 => case eqbspec : eqb.

Instance eqb_inst_nat : Eqb nat := Nat.eqb.
Instance eqbspec_nat : EqbSpec nat := Nat.eqb_spec.

Arguments eqb_inst_nat !_ !_.

Lemma eqb_refl {A} `{EqbSpec A} (x:A) : (x =? x) = true.
Proof.
 now case eqbspec.
Qed.

Lemma eqb_eq {A} `{EqbSpec A} (x y:A) : (x =? y) = true <-> x = y.
Proof.
 now case eqbspec.
Qed.

Lemma eqb_neq {A} `{EqbSpec A} (x y:A) : (x =? y) = false <-> x <> y.
Proof.
 now case eqbspec.
Qed.

Lemma eqb_sym {A} `{EqbSpec A} (x y:A) : (x =? y) = (y =? x).
Proof.
 case (eqbspec y x); intros.
 - apply eqb_eq. auto.
 - apply eqb_neq. auto.
Qed.

Ltac cons := constructor; congruence.

(** for Couples *)

Instance eqb_inst_couples {A}`{Eqb A} {B}`{Eqb B} : Eqb (A*B) :=
  fun '(x1,x2) '(y1,y2) => (x1 =? y1) && (x2 =? y2).

Instance eqbspec_couples {A}`{EqbSpec A} {B}`{EqbSpec B}  : EqbSpec (A*B).
Proof.
  red.
  intros.
  simpl. destruct x; destruct y.
  case (eqbspec a a0); case (eqbspec b b0); intros H3 H4; subst; unfold eqb; simpl.
  do 2 rewrite eqb_refl; simpl; cons.
  apply eqb_neq in H3; rewrite H3; rewrite andb_false_r; constructor.
  unfold not; intros; injection H4 as H4; subst; apply eqb_neq in H3; destruct H3; trivial.
  apply eqb_neq in H4; rewrite H4; rewrite andb_false_l; constructor.
  unfold not; intros; injection H3 as H3; subst; apply eqb_neq in H4; destruct H4; trivial.
  apply eqb_neq in H3; rewrite H3; rewrite andb_false_r; constructor.
  unfold not; intros; injection H5 as H5; subst; apply eqb_neq in H3; destruct H3; trivial.
Defined.

(** for Lists *)

Definition list_forallb {A B} (f: A -> B -> bool) :=
 fix forallb2 l1 l2 :=
 match l1, l2 with
 | [], [] => true
 | x1::l1, x2::l2 => f x1 x2 && forallb2 l1 l2
 | _, _ => false
 end.

Instance eqb_inst_list {A}`{Eqb A} : Eqb (list A) := list_forallb eqb.

Instance eqbspec_list {A}`{EqbSpec A} : EqbSpec (list A).
Proof.
 red.
 induction x; destruct y; simpl; try cons.
 cbn.
 case eqbspec; [ intros <- | cons ].
 case IHx; cons.
Defined.

Fixpoint indexOf{A:Type}`{Eqb A} x l :=
  match l with
  | []     => None
  | e::l' => if (e =? x) then Some 0 else option_map S (indexOf x l')
  end.

(* Nécessité de faire un replace en retirant x et en rajoutant y avec push pour certaines règles *)

Fixpoint list_mem {A}`{Eqb A} (x:A) (l:list A) :=
  match l with
  | [] => false
  | y::l => (x =? y) || list_mem x l
  end.

Fixpoint intersection {A}`{Eqb A} (l1 l2:list A) :=
  match l1 with
  |x::l1' => let res := (intersection l1' l2) in
                (if list_mem x l2 then x :: res else res)
  |[]     => []
  end.

Fixpoint remove{A:Type}`{Eqb A} x (l:@list A) :=
  match l with
  | []     => []
  | e::l' => if (e =? x) then l' else e::(remove x l')
   end.

Definition replace{A:Type}`{Eqb A} x y (l:@list A) (push: A -> @list A -> @list A) := push y (remove x l).