Require Import UniMath.Foundations.Generalities.uu0.
Require Import UniMath.Foundations.hlevel1.hProp.
Require Import UniMath.Foundations.hlevel2.hSet.

Require Import UniMath.RezkCompletion.precategories.
Require Import UniMath.RezkCompletion.functor_categories.
Require Import UniMath.RezkCompletion.whiskering.
Require Import UnicodeNotations.
(*Require Import RezkCompletion.whiskering.*)
(*Require Import RezkCompletion.FunctorAlgebras.*)
Require Import Auxiliary.

Local Notation "# F" := (functor_on_morphisms F)(at level 3).
Local Notation "F ⟶ G" := (nat_trans F G) (at level 39).
Local Notation "G □ F" := (functor_composite _ _ _ F G) (at level 35).

Ltac pathvia b := (apply (@pathscomp0 _ _ b _ )).

Section horizontal_composition.

Variables C D E : precategory.

Variables F F' : functor C D.
Variables G G' : functor D E.

Variable α : F ⟶ F'.
Variable β : G ⟶ G'.

Lemma is_nat_trans_horcomp : is_nat_trans (G □ F) (G' □ F')
  (λ c : C, β (F c) ;; #G' (α _ )).
Proof.
  intros c d f; simpl.
  rewrite assoc.
  rewrite nat_trans_ax.
  repeat rewrite <- assoc; apply maponpaths.
  repeat rewrite <- functor_comp.
  rewrite nat_trans_ax; apply idpath.
Qed.

Definition hor_comp : nat_trans (G □ F) (G' □ F') := tpair _ _ is_nat_trans_horcomp.

End horizontal_composition.

Arguments hor_comp { _ _ _ } { _ _ _ _ } _ _ .

(*
Lemma horcomp_id_left (C D : precategory) (X : functor C C) (Z Z' : functor C D)(f : nat_trans Z Z')
  :
  hor_comp (nat_trans_id X) f = pre_whisker f.
*)
Lemma horcomp_id_left (C D : precategory) (X : functor C C) (Z Z' : functor C D)(f : nat_trans Z Z')
  :
  forall c : C, hor_comp (nat_trans_id X) f c = f (X c).
Proof.
  simpl.
  intro c.
  rewrite functor_id.
  rewrite id_right.
  apply idpath.
Qed.

Lemma horcomp_id_postwhisker (A B C : precategory)
   (hsB : has_homsets B) (hsC : has_homsets C) (X X' : [A, B, hsB]) (α : X ⇒ X')
   (Z : [B ,C, hsC])
  : hor_comp α (nat_trans_id _ ) = post_whisker hsB hsC _ _ α Z.
Proof.
  apply nat_trans_eq.
  - apply hsC.
  - intro a.
    apply id_left.
Qed.


Require Import VST.floyd.proofauto.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.MathUAdjMatGraph.
Require Export CertiGraph.graph.SpaceAdjMatGraph1.
Require Import CertiGraph.lib.List_ext.

Local Open Scope logic.

Section Spatial_UAdjMat_Model_2.
  (* Model 1 is for a heap-allocated graph,
     where the graph is malloc-ed
     by first malloc-ing a "spine" column of some size,
     and then malloc-ing a "row" into each cell
     of the spine.
   *)

Context {size : Z}.
Context {inf : Z}.

Definition graph_to_symm_mat g :=
  @graph_to_mat size g eformat.

Lemma graph_to_mat_eq:
  forall (g: AdjMatLG) i j, 0 <= i < size -> 0 <= j < size ->
    (Znth i (Znth j (graph_to_symm_mat g))) = elabel g (eformat (i,j)).
Proof.
  intros.
  symmetry. rewrite eformat_symm.
  apply elabel_Znth_graph_to_mat; lia.
Qed.

Lemma graph_to_mat_symmetric:
  forall (g: AdjMatLG) i j,
    0 <= i < size -> 0 <= j < size ->
    (Znth i (Znth j (graph_to_symm_mat g))) =
    (Znth j (Znth i (graph_to_symm_mat g))).
Proof.
  intros. repeat rewrite graph_to_mat_eq; trivial.
  f_equal. apply eformat_symm.
Qed.

Lemma graph_to_mat_inf:
  forall (g: @AdjMatGG size inf) u v,
    0 <= u < v ->
    v < size ->
    ~ evalid g (u,v) ->
    Znth v (Znth u (graph_to_symm_mat g)) =
    inf.
Proof.
  intros. unfold graph_to_symm_mat.
  rewrite <- elabel_Znth_graph_to_mat; try lia.
  rewrite eformat1.
  apply (MathAdjMatGraph.invalid_edge_weight); auto.
  simpl; lia.
Qed.

Context {size_rep': 0 < size <= Int.max_signed}.
Context {inf_rep: 0 < inf < Int.max_signed}.

Definition edgeless_graph' := @edgeless_graph size inf inf_rep size_rep'.
Definition adde := @UAdjMatGG_adde size inf.
Definition eremove := @UAdjMatGG_eremove size inf.

Lemma edgeless_vert_rep:
  forall v,
    0 <= v < size ->
    (@vert_to_list size edgeless_graph' eformat v) =
    list_repeat (Z.to_nat size) inf.
Proof.
  unfold vert_to_list; intros. rewrite map_map. apply list_eq_Znth.
+rewrite Zlength_map, nat_inc_list_Zlength, Zlength_list_repeat'; auto.
+intros. rewrite Zlength_map, nat_inc_list_Zlength, Z2Nat.id in H0. 2: lia.
rewrite Znth_list_repeat_inrange by auto.
rewrite Znth_map, nat_inc_list_i. simpl; auto.
rewrite Z2Nat.id; lia.
rewrite nat_inc_list_Zlength.
rewrite Z2Nat.id; lia.
Qed.

Lemma edgeless_to_symm_mat:
  graph_to_symm_mat edgeless_graph' =
  list_repeat (Z.to_nat size) (list_repeat (Z.to_nat size) inf).
Proof.
  unfold graph_to_symm_mat, graph_to_mat. apply list_eq_Znth.
+rewrite Zlength_map, nat_inc_list_Zlength, Zlength_list_repeat'; auto.
+intros. rewrite Zlength_map, nat_inc_list_Zlength, Z2Nat.id in H by lia.
rewrite Znth_list_repeat_inrange by lia.
rewrite Znth_map. rewrite nat_inc_list_i. apply edgeless_vert_rep; lia.
rewrite Z2Nat.id by lia; lia.
rewrite nat_inc_list_Zlength, Z2Nat.id; lia.
Qed.

End Spatial_UAdjMat_Model_2.


Require Import Morphisms Setoid.
Require Import Utf8.

Add LoadPath "../../theories" as CatQ.
From CatQ.Structures Require Import Structures.
From CatQ.Categories Require Import FunCat.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Set Universe Polymorphism.

Lemma eqn_sym_inv_r {C D} {F F' : Functor C D} (eq : F ==f F') : proj1_sig (eqf_to_eqn eq) ∘n proj1_sig (eqf_to_eqn (symmetry eq)) == idNat F' in [C,D].
Proof.
  simpl.
  intro.
  unfold eq_to_hom.
  rewrite <- extend_compose_left, extend_eq.
  rewrite left_id_of.
  rewrite extend_trans.
  rewrite extend_eq.
  reflexivity.
Qed.

Lemma eqn_sym_inv_l {C D} {F F' : Functor C D} (eq : F ==f F') : proj1_sig (eqf_to_eqn (symmetry eq)) ∘n proj1_sig (eqf_to_eqn eq) == idNat F in [C,D].
Proof.
  simpl.
  intro.
  unfold eq_to_hom.
  rewrite <- extend_compose_left, extend_eq.
  rewrite left_id_of.
  rewrite extend_trans.
  rewrite extend_eq.
  reflexivity.
Qed.

Lemma eq_sym_of_eqf {C D} {F F' : Functor C D} (eq : F ==f F') {A} : (~ proj1_sig eq A) = proj1_sig (symmetry eq) A.
Proof.
  destruct eq.
  simpl.
  reflexivity.
Qed.

Lemma nat_extend {C D} {F G : Functor C D} {η : Nat F G} {a b} (p : a = b) :
  extend (fobj_eq p) (fobj_eq p) (η a) = η b.
Proof.
  destruct p.
  auto.
Qed.

Lemma fstar_distr {C D U} {S : Functor D U} {F G H : Functor C D} {α : Nat G H} {β : Nat F G} : S f⋆ (α ∘n β) == (S f⋆ α) ∘n (S f⋆ β) in [C,U].
Proof.
  simpl.
  intro.
  apply fmap_compose.
Qed.

Lemma fobj_eq_preserve_sym {C D} {F : Functor C D} {a b : C} (p : a = b) : (~ fobj_eq (F:=F) p) = fobj_eq (~ p).
Proof.
  destruct p.
  auto.
Qed.


Require Import Tweetnacl.Libs.Export.
Require Import ssreflect.
Require Import Recdef.
(*
Require Import Tweetnacl.Libs.HeadTailRec.
*)

Section ScalarRec.
Open Scope Z.

Variable M : list Z -> list Z -> list Z.
Variable Sq : list Z -> list Z.

(*
sv inv25519(gf o,const gf i)
{
  gf c;
  int a;
  FOR(a,16) c[a]=i[a];
  for(a=253;a>=0;a--) {
    S(c,c);
    if(a!=2&&a!=4) M(c,c,i);
  }
  FOR(a,16) o[a]=c[a];
}
*)

Definition recurse (a : Z) : nat := Z.to_nat (a + 1).

Definition step_pow (a:Z) (c g:list Z) : list Z :=
    let c := Sq c in
      if (andb (Zneq_bool a 2) (Zneq_bool a 4))
      then M c g
      else c.

Function pow_fn_rev (a b:Z) (c g: list Z) {measure Z.to_nat a} : (list Z) :=
  if (a <=? 0)
    then c
    else
      let prev := pow_fn_rev (a - 1) b c g in
        step_pow (b - a) prev g.
Proof. intros. apply Z2Nat.inj_lt ; move: teq ; rewrite Z.leb_gt => teq; omega. Defined.

Lemma pow_fn_rev_0 : forall b c g,
  pow_fn_rev 0 b c g = c.
Proof. go. Qed.

Lemma pow_fn_rev_n : forall a b c g,
  0 < a ->
  pow_fn_rev a b c g = step_pow (b - a) (pow_fn_rev (a - 1) b c g) g.
Proof. intros. rewrite pow_fn_rev_equation.
flatten ; apply Zle_bool_imp_le in Eq; omega.
Qed.

Variable M_Zlength : forall a b, Zlength a = 16 -> Zlength b = 16 -> Zlength (M a b) = 16.
Variable Sq_Zlength : forall a, Zlength a = 16 -> Zlength (Sq a) = 16.

Lemma step_pow_Zlength : forall a c g,
  Zlength c = 16 ->
  Zlength g = 16 ->
  Zlength (step_pow a c g) = 16.
Proof.
  intros.
  rewrite /step_pow.
  flatten;
  repeat match goal with
     | _ => auto
     | _ => rewrite M_Zlength
     | _ => rewrite Sq_Zlength
   end.
Qed.

Lemma pow_fn_rev_Zlength : forall a b c g,
  Zlength c = 16 ->
  Zlength g = 16 ->
  Zlength (pow_fn_rev a b c g) = 16.
Proof.
destruct a; intros.
go.
2: go.
remember (Z.pos p) as a.
assert(0 <= a).
  subst; apply Zle_0_pos.
clears p.
gen b c g.
gen a.
apply (natlike_ind (fun a => forall (b : ℤ) (c : list ℤ),
Zlength c = 16 -> forall g : list ℤ, Zlength g = 16 -> Zlength (pow_fn_rev a b c g) = 16)).
intros; go.
intros a Ha IHa b c Hc g Hg .
rewrite pow_fn_rev_equation.
flatten.
oreplace (Z.succ a- 1) a.
apply step_pow_Zlength ; auto.
Qed.

Variable M_bound_Zlength : forall a b,
  Zlength a = 16 ->
  Zlength b = 16 ->
  Forall (fun x => -Z.pow 2 26 < x < Z.pow 2 26) a ->
  Forall (fun x => -Z.pow 2 26 < x < Z.pow 2 26) b ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) (M a b).
Variable Sq_bound_Zlength : forall a,
  Zlength a = 16 ->
  Forall (fun x => -Z.pow 2 26 < x < Z.pow 2 26) a ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) (Sq a).

Local Ltac solve_Zlength :=
  intros;
  repeat match goal with
    | _ => orewrite M_Zlength
    | _ => orewrite Sq_Zlength
  end ; auto.

Local Ltac Simplify_this :=
change (2^16) with 65536 in *;
change (2^26) with 67108864 in *.

Lemma step_pow_bound_Zlength : forall a c g,
  Zlength c = 16 ->
  Zlength g = 16 ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) c ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) g ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) (step_pow a c g).
Proof.
  intros.
  rewrite /step_pow.
  flatten;
  repeat match goal with
    | _ => Simplify_this ; intros x Hx ; simpl in Hx ; omega
    | _ => apply M_bound_Zlength ; solve_Zlength
    | _ => apply Sq_bound_Zlength ; solve_Zlength
    | _ => apply H1
    | _ => apply H2
    | _ => eapply list.Forall_impl
  end.
Qed.

Lemma pow_fn_rev_bound_Zlength : forall a b c g,
  Zlength c = 16 ->
  Zlength g = 16 ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) c ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) g ->
  Forall (fun x => -38 <= x < Z.pow 2 16 + 38) (pow_fn_rev a b c g).
Proof.
destruct a; intros.
go.
2: go.
remember (Z.pos p) as a.
assert(0 <= a).
  subst; apply Zle_0_pos.
clears p.
gen b c g.
gen a.
apply (natlike_ind (fun a =>
forall (b : ℤ) (c : list ℤ),
Zlength c = 16 ->
Forall (fun x : ℤ => -38 <= x < 2 ^ 16 + 38) c ->
forall g : list ℤ,
Zlength g = 16 ->
Forall (fun x : ℤ => -38 <= x < 2 ^ 16 + 38) g -> Forall (fun x : ℤ => -38 <= x < 2 ^ 16 + 38) (pow_fn_rev a b c g))).
intros; go.
intros a Ha IHa b c Hc Hcc g Hg Hgg.
rewrite pow_fn_rev_equation.
flatten.
oreplace (Z.succ a- 1) a.
apply step_pow_bound_Zlength ; auto.
apply pow_fn_rev_Zlength ; auto.
Qed.

Close Scope Z.
End ScalarRec.