From Undecidability.L.Tactics Require Import LTactics GenEncode.
From Undecidability.L.Datatypes Require Import LNat Lists LFinType.

Require Import Undecidability.Shared.Libs.PSL.Vectors.Vectors.

(* *** Encoding vectors *)

Instance register_vector X `{registered X} n : registered (Vector.t X n).
Proof.
  apply (registerAs VectorDef.to_list).
  intros x. induction x.
  - intros y. pattern y. revert y. eapply VectorDef.case0. cbn. reflexivity.
  - intros y. clear H. revert h x IHx. pattern n, y. revert n y.
    eapply Vector.caseS. intros h n y h0 x IHx [=].
    subst. f_equal. eapply IHx. eassumption.
Defined. (*because registerAs*)

Lemma enc_vector_eq X `{registered X} m (x:Vector.t X m):
  enc x = enc (Vector.to_list x).
Proof.
  reflexivity.
Qed.

Instance term_to_list X `{registered X} n : computableTime' (Vector.to_list (A:=X) (n:=n)) (fun _ _ => (1,tt)).
Proof.
  apply cast_computableTime.
Qed.

Import Vector.
Instance term_vector_map X Y `{registered X} `{registered Y} n (f:X->Y) fT:
  computableTime' f fT ->
  computableTime' (VectorDef.map f (n:=n))
                 (fun l _ => (map_time (fun x=> fst (fT x tt)) (Vector.to_list l) + 3,tt)).
Proof.
  intros ?.
  computable_casted_result.
  apply computableTimeExt with (x:= fun x => List.map f (Vector.to_list x)).
  2:{
    extract.
    solverec.
  }

  cbn. intros x.
  clear - x.
  induction n. revert x. apply VectorDef.case0. easy. revert IHn. apply Vector.caseS' with (v:=x).
  intros. cbn. f_equal. fold (Vector.fold_right (A:=X) (B:=Y)).
  setoid_rewrite IHn. reflexivity.
Qed.

(* Instance term_vector_map X Y `{registered X} `{registered Y} n (f:X->Y): computable f -> computable (VectorDef.map f (n:=n)). *)
(* Proof. *)
(*   intros ?. *)

(*   internalize_casted_result. *)
(*   apply computableExt with (x:= fun x => map f (Vector.to_list x)). *)
(*   2:{ *)
(*     extract. *)
(*   } *)

(*   cbn. intros x.  *)
(*   clear - x. *)
(*   induction n. revert x. apply VectorDef.case0. easy. revert IHn. apply Vector.caseS' with (v:=x). *)
(*   intros. cbn. f_equal. fold (Vector.fold_right (A:=X) (B:=Y)). *)
(*   setoid_rewrite IHn. reflexivity. *)
(* Qed. *)

Fixpoint time_map2 {X Y Z} `{registered X} `{registered Y} `{registered Z} (gT : timeComplexity (X->Y->Z)) (l1 :list X) (l2 : list Y) :=
  match l1,l2 with
  | x::l1,y::l2 => callTime2 gT x y + 18 + time_map2 gT l1 l2
  | _,_ => 9
  end.
Instance term_map2 n A B C `{registered A} `{registered B} `{registered C} (g:A -> B -> C) gT:
  computableTime' g gT-> computableTime' (Vector.map2 g (n:=n)) (fun l1 _ => (1,fun l2 _ => (time_map2 (X:=A) (Y:=B) (Z:=C) gT (Vector.to_list l1) (Vector.to_list l2) +8,tt))).
Proof.
  intros ?.
  computable_casted_result.
  pose (f:=(fix f t a : list C:=
              match t,a with
                t1::t,a1::a => g t1 a1 :: f t a
              | _,_ => []
              end)).
  assert (computableTime' f (fun l1 _ => (5,fun l2 _ => (time_map2 gT l1 l2,tt)))).
  {subst f; extract.

   solverec. }
  apply computableTimeExt with (x:= fun t a => f (Vector.to_list t) (Vector.to_list a)).
  2:{extract. solverec. }
  induction n;cbn.
  -do 2 destruct x using Vector.case0. reflexivity.
  -destruct x using Vector.caseS'. destruct x0 using Vector.caseS'.
   cbn. f_equal. apply IHn.
Qed.

Lemma time_map2_leq X Y Z `{registered X} `{registered Y} `{registered Z} (fT:timeComplexity (X -> Y -> Z))(l1 : list X) (l2:list Y) k:
  (forall x y, callTime2 fT x y <= k) ->
  time_map2 fT l1 l2<= length l1 * (k+18) + 9.
Proof.
  intros H';
    induction l1 in l2|-*;cbn [time_map2].
  -intuition.
  -destruct l2;ring_simplify. intuition.
   rewrite H',IHl1. cbn [length]. ring_simplify. intuition.
Qed.

Instance term_vector_eqb X `{registered X} (n' m:nat) (eqb:X->X->bool) eqbT:
  computableTime' eqb eqbT
  -> computableTime'
      (VectorEq.eqb eqb (A:=X) (n:=n') (m:=m))
      (fun A _ => (1,fun B _ => (list_eqbTime eqbT (Vector.to_list A) (Vector.to_list B) + 9,tt))).
Proof.
  intros ?.
  apply computableTimeExt with (x:=(fun x y => list_eqb eqb (Vector.to_list x) (Vector.to_list y))).
  2:{extract.
     solverec. }
  intros v v'. hnf.
  induction v in n',v'|-*;cbn;destruct v';cbn;try tauto. rewrite <- IHv. f_equal.
Qed.

(*MOVE*)
Lemma to_list_length X n0 (l:Vector.t X n0) :length (Vector.to_list l) = n0.
Proof.
  induction l. reflexivity. rewrite <- IHl at 3. reflexivity.
Qed.

From Undecidability.L Require Import Functions.EqBool.

Global Instance eqbVector X eqbx `{eqbClass (X:=X) eqbx} n:
  eqbClass (VectorEq.eqb eqbx (n:=n) (m:=n)).
Proof.
  intros ? ?. eapply vector_eqb_spec. all:eauto using eqb_spec.
Qed.

Global Instance eqbComp_List X `{registered X} `{eqbCompT X (R:=_)} n:
  eqbCompT (Vector.t X n).
Proof.
  evar (c:nat). exists c. edestruct term_vector_eqb with (X:=X). now eauto using comp_eqb.
  eexists.
  eapply computesTime_timeLeq. 2:eauto. clear.
  repeat (hnf;intros;cbn [fst snd];split). easy.
  unfold enc;cbn - [plus mult c max] in *. all:fold (@enc X _).
  change VectorDef.to_list with (@Vector.to_list X n).
  generalize (Vector.to_list x) as l, (Vector.to_list x0). clear.
  setoid_rewrite size_list.
  induction l;intros l'.
  -cbn - [plus mult c max min] in *.
    unfold c__listsizeNil, c__listsizeCons.
   enough (10<= c). nia. shelve.
  -destruct l' as [ |? l'].
   all:cbn - [plus mult c max min] in *; unfold c__listsizeNil, c__listsizeCons in *.
   1:{ enough (10<= c). nia. shelve. }
   specialize (IHl l').
   unfold eqbTime at 1.
   enough (10+c__eqbComp X<= c ). nia. shelve.
  [c]:exact (c__eqbComp X + 10).
   Unshelve. all:subst c. all:nia.
Qed.