(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

Require Import BV_Gen.
Require map.Map.
Require Import Lia.

(* Why3 goal *)
Definition component_type : Type.
Proof.
exact Z.
Defined.

(* Why3 goal *)
Definition rep_type : Type.
Proof.
exact Z.
Defined.

(* Why3 goal *)
Definition map : Type.
Proof.
exact (map.Map.map BV_Gen.t Z).
Defined.

(* Why3 goal *)
Definition t : Type.
Proof.
exact BV_Gen.t.
Defined.

(* Why3 goal *)
Definition le : t -> t -> Prop.
Proof.
exact ule.
Defined.

(* Why3 goal *)
Definition lt : t -> t -> Prop.
Proof.
exact ult.
Defined.

(* Why3 goal *)
Definition gt : t -> t -> Prop.
Proof.
exact ugt.
Defined.

(* Why3 goal *)
Definition add : t -> t -> t.
Proof.
exact BV_Gen.add.
Defined.

(* Why3 goal *)
Definition sub : t -> t -> t.
Proof.
exact BV_Gen.sub.
Defined.

(* Why3 goal *)
Definition one : t.
Proof.
exact (of_int 1).
Defined.

(* Why3 goal *)
Definition rep_lt : rep_type -> rep_type -> Prop.
Proof.
 exact Z.lt.
Defined.

(* Why3 goal *)
Definition rep_gt : rep_type -> rep_type -> Prop.
Proof.
 exact Z.gt.
Defined.

(* Why3 goal *)
Definition to_rep : component_type -> rep_type.
Proof.
 exact (fun x => x).
Defined.

(* Why3 goal *)
Definition get : map -> t -> component_type.
Proof.
exact (fun f a => f a).
Defined.

Fixpoint array_eq (a : map.Map.map t component_type)
  (af : t) (b : map.Map.map t component_type) (bf : t) (h : nat) : bool :=
  match (to_rep (a af) ?= to_rep (b bf))%Z with
   | Eq =>
    match h with
     | O => true
     | S (n) => array_eq a (add af one) b (add bf one) n
    end
   | _ => false
  end.

(* The last index is intentionally not included in the count, so length_array
   returns 0 on an array containing only one element. *)
Definition array_length : t -> t -> nat.
Proof.
exact (fun f l => Z.to_nat (((to_uint l) - (to_uint f))%Z)).
Defined.

(* Why3 goal *)
Definition bool_eq : map -> t -> t -> map -> t -> t -> Init.Datatypes.bool.
Proof.
 exact (fun a af al b bf bl =>
  match (to_uint af ?= to_uint al)%Z, (to_uint bf ?= to_uint bl)%Z with
    | Gt, Gt => true
    | Gt, _  => false
    | _, Gt  => false
    | _, _   =>
       match (array_length af al) ?= (array_length bf bl) with
        | Eq => array_eq a af b bf (array_length af al)
        | _ => false
       end
  end).
Defined.

Fixpoint array_lcp (a : map.Map.map t component_type)
  (af : t) (b : map.Map.map t component_type) (bf : t) (h : nat) : t :=
  match h with
  | O => af
  | S (n) =>
    match (to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z with
    | Eq => array_lcp a (add af one) b (add bf one) n
    | _ => af
    end
  end.

Lemma one_less_than_two_power_size:
  (1 < two_power_size)%Z.
Proof.
unfold two_power_size, size, size_nat.
rewrite <- Pow2int.pow2_0.
rewrite <- Nat2Z.inj_0.
apply pow2_lt_mono_nat.
lia.
Qed.

Ltac reduce_to_lia :=
unfold add, BV_Gen.add, one;
rewrite mod1_out;
repeat rewrite to_uint_of_int;
try split; try (unfold to_uint; lia);
try lia; try apply one_less_than_two_power_size.

Lemma lcp_more_than_first :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat h)%Z ->
  le af (array_lcp a af b bf h).
Proof.
intros a b; unfold le, ule; induction h; intros af bf H_a.
unfold array_lcp; lia.
unfold array_lcp; fold array_lcp.
case (to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z; try lia.
apply (Z.le_trans _ (to_uint (add af one)) _); [| apply IHh];
reduce_to_lia.
Qed.

Lemma length_next :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat (S h))%Z ->
  array_length af (array_lcp a (add af one) b (add bf one) h) =
  S (array_length (add af one) (array_lcp a (add af one) b (add bf one) h)).
Proof.
intros a b h af bf Ha.
remember (array_length (add af one) (array_lcp a (add af one) b (add bf one) h)) as n.
rewrite Heqn.
unfold array_length.
assert (forall i j : t, (to_uint j < two_power_size - 1)%Z ->
             (to_uint i - to_uint j = Z.succ (to_uint i - to_uint (add j one)))%Z) by
(intros i j B; reduce_to_lia).
rewrite (H _ af); try lia.
rewrite Z2Nat.inj_succ; auto.
apply Zle_minus_le_0.
apply (lcp_more_than_first a b h (add af one) (add bf one));
reduce_to_lia.
Qed.

Lemma lcp_less_than_h :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat h)%Z ->
  array_length af (array_lcp a af b bf h) <= h.
Proof.
intros a b; induction h; intros af bf H_a.
unfold array_lcp, array_length; lia.
unfold array_lcp; fold array_lcp.
case (to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z;
try (unfold array_length; lia).
rewrite length_next by auto.
apply Peano.le_n_S.
apply IHh; reduce_to_lia.
Qed.

Lemma lcp_eq :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat h)%Z ->
  (to_rep (get a af) = to_rep (get b bf))%Z ->
  let ai := array_lcp a af b bf h in
  let l := array_length af ai in
  array_eq a af b bf l = true.
Proof.
intros a b.
(* The proof is done by induction over the natural number h *)
induction h.
(* Base case *)
* unfold array_lcp, array_length, get.
  intros af bf _ H_e.
  rewrite Zminus_diag; simpl.
  rewrite H_e; rewrite Z.compare_refl; auto.
(* Inductive case *)
* intros af bf H_a H_e;
  unfold get in H_e;
  unfold array_lcp; fold array_lcp.
  (* Reason by case on (a (af + 1) ?= b (bf + 1));
     discharge the simple cases directly *)
  case_eq ((to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z);
  try (unfold array_length; rewrite Zminus_diag; simpl;
       rewrite H_e; rewrite Z.compare_refl; auto).

  intro H_e_n.
  (* To unfold array_eq, reason by case on the value of the length;
     discharge the simple cases directly *)
  case_eq (array_length af (array_lcp a (add af one) b (add bf one) h));
  simpl; rewrite H_e; rewrite Z.compare_refl; auto.

  intros n H_l.

  (* Rewrite n and apply the induction hypothesis *)
  + rewrite (length_next a b h af bf) in H_l by auto.
    apply Nat.succ_inj in H_l.
    rewrite <- H_l.
    apply IHh.
    reduce_to_lia.
    unfold get; apply Z.compare_eq; auto.
Qed.

Lemma lcp_next :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat h)%Z ->
  (to_rep (get a af) = to_rep (get b bf))%Z ->
  let ai := array_lcp a af b bf h in
  let bi := array_lcp b bf a af h in
  let l := array_length af ai in
  l = h \/ l < h /\ (to_rep (get a (add ai one)) <> to_rep (get b (add bi one)))%Z.
Proof.
intros a b.
(* The proof is done by induction over the natural number h *)
induction h.
(* Base case *)
* unfold array_lcp, array_length, get.
  intros af bf _ H_e.
  left; rewrite Zminus_diag; simpl; auto.
(* Inductive case *)
* intros af bf H_a H_e;
  unfold get in H_e;
  unfold array_lcp; fold array_lcp.
  (* Reason by case on (a (af + 1) ?= b (bf + 1));
     discharge the simple cases directly *)
  rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
  case_eq ((to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z); simpl;
  try (intro C; right; unfold get; simpl;
       split;
       [ unfold array_length; lia
       | intro B; rewrite B in C;
         rewrite Z.compare_refl in C; discriminate C]).

  (* Apply the induction hypothesis *)
  intro H_e_n; apply Z.compare_eq in H_e_n; simpl.
  assert (to_uint (add af one) < two_power_size - Z.of_nat h)%Z by reduce_to_lia.
  assert (to_rep (get a (add af one)) = to_rep (get b (add bf one))) by (unfold get; auto).
  pose proof (IHh (add af one) (add bf one) H H0) as [HI | [HIL HIR]].
  + left.
    rewrite length_next by lia; rewrite HI; auto.
  + right; split; auto.
    rewrite length_next by lia.
    lia.
Qed.

Lemma lcp_sym :
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat h)%Z ->
  (to_uint bf < two_power_size - Z.of_nat h)%Z ->
  let ai := array_lcp a af b bf h in
  let bi := array_lcp b bf a af h in
  array_length af ai = array_length bf bi.
Proof.
intros a b.
(* The proof is done by induction over the natural number h *)
induction h.
(* Base case *)
* unfold array_lcp, array_length.
  intros af bf _ _.
  repeat rewrite Zminus_diag; simpl; auto.
(* Inductive case *)
* intros af bf H_a H_b;
  unfold array_lcp; fold array_lcp.
  (* Reason by case on (a (af + 1) ?= b (bf + 1));
     discharge the simple cases directly *)
  rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
  case ((to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z);
  try (simpl; unfold array_length;
       repeat rewrite Zminus_diag; lia).
  (* Apply the induction hypothesis *)
  assert (to_uint (add af one) < two_power_size - Z.of_nat h)%Z by reduce_to_lia.
  assert (to_uint (add bf one) < two_power_size - Z.of_nat h)%Z by reduce_to_lia.
  simpl.
  pose proof (IHh _ _ H H0) as HR.
  repeat rewrite length_next by lia.
  rewrite HR; auto.
Qed.

(* Why3 goal *)
Definition lcp : map -> t -> t -> map -> t -> t -> t.
Proof.
  exact (fun a af al b bf bl =>
  match array_length af al ?= array_length bf bl with
   | Eq | Lt => array_lcp a af b bf (array_length af al)
   | Gt => array_lcp a af b bf (array_length bf bl)
  end).
Defined.

Lemma z_compare_lt:
  forall (x y : Z), (x ?= y)%Z = Lt -> (x < y)%Z.
Proof.
intros x y; apply Z.compare_lt_iff.
Qed.

Lemma z_compare_gt:
  forall (x y : Z), (x ?= y)%Z = Gt -> (x > y)%Z.
Proof.
intros x y H; apply Z.compare_gt_iff in H; lia.
Qed.

Lemma z_compare_lt_rev:
  forall (x y : Z), (x < y)%Z -> (x ?= y)%Z = Lt.
Proof.
intros x y; apply Z.compare_lt_iff.
Qed.

Lemma z_compare_gt_rev:
  forall (x y : Z), (x > y)%Z -> (x ?= y)%Z = Gt.
Proof.
intros x y H; apply Z.compare_gt_iff; lia.
Qed.

(* Pose some useful proofs depending on the longuest array in a call to lcp *)
Ltac pose_proofs a b af al bf bl uf ul :=
  (* Compute the bound on af and bf necessary to apply lcp_more_than_first. *)
  assert (to_uint af < two_power_size - Z.of_nat (Z.to_nat (to_uint ul - to_uint uf)))%Z as H_a_bnd by
  lia;
  assert (to_uint bf < two_power_size - Z.of_nat (Z.to_nat (to_uint ul - to_uint uf)))%Z as H_b_bnd by
  lia;
  (* Apply lcp_more_than_first for both applications of lcp.
     They provide the bounds necessary to apply lcp_sym. *)
  pose proof (lcp_more_than_first a b (array_length uf ul) af bf H_a_bnd) as H_m_l_a;
  unfold le, ule in H_m_l_a;
  pose proof (lcp_more_than_first b a (array_length uf ul) bf af H_b_bnd) as H_m_l_b;
  unfold le, ule in H_m_l_b;
  (* Apply lcp_less_than_h for both applications of lcp.
     They provide the bounds necessary to apply lcp_sym. *)
  pose proof (lcp_less_than_h a b (array_length uf ul) af bf H_a_bnd) as H_l_h_a;
  apply Z2Nat.inj_le in H_l_h_a; try lia;
  pose proof (lcp_less_than_h b a (array_length uf ul) bf af H_b_bnd) as H_l_h_b;
  apply Z2Nat.inj_le in H_l_h_b; try lia;
  (* Use lcp_sym to state that both applications of lcp are equal *)
  pose proof (lcp_sym a b (array_length uf ul) af bf H_a_bnd H_b_bnd) as H_sym;
  apply (Z2Nat.inj _ _) in H_sym; try (lia).

Ltac case_on_length a b af al bf bl uf ul :=
  (* Check that a and b are not empty *)
  case_eq (to_uint af ?= to_uint (array_lcp a af b bf (array_length uf ul)))%Z;
  intros H_empty_a;
  try (apply Z.compare_eq in H_empty_a);
  try (apply z_compare_lt in H_empty_a);
  try (apply z_compare_gt in H_empty_a);
  try (contradict H_empty_a; lia);
  case_eq (to_uint bf ?= to_uint (array_lcp b bf a af (array_length uf ul)))%Z;
  intros H_empty_b;
  try (apply Z.compare_eq in H_empty_b);
  try (apply z_compare_lt in H_empty_b);
  try (apply z_compare_gt in H_empty_b);
  try (contradict H_empty_a; lia).

Ltac case_and_pose_proof a b af al bf bl :=
  unfold lcp;
  try (rewrite (Nat.compare_antisym (array_length af al) (array_length bf bl)));
  case_eq (array_length af al ?= array_length bf bl); simpl;
  intros H_length;
  [ apply Nat.compare_eq in H_length; try (rewrite H_length); unfold array_length in H_length;
    pose_proofs a b af al bf bl bf bl
  | apply nat_compare_Lt_lt in H_length; repeat unfold array_length in H_length;
    pose_proofs a b af al bf bl af al
  | apply nat_compare_Gt_gt in H_length; repeat unfold array_length in H_length;
    pose_proofs a b af al bf bl bf bl].

(* Why3 goal *)
Lemma lcp_def :
  forall (a:map) (b:map),
  forall (a_first:t) (a_last:t) (b_first:t) (b_last:t),
  le a_first a_last /\
  le b_first b_last /\ ((to_rep (get a a_first)) = (to_rep (get b b_first))) ->
  let a_i := lcp a a_first a_last b b_first b_last in
  let b_i := lcp b b_first b_last a a_first a_last in
  ((sub a_i a_first) = (sub b_i b_first)) /\
  le a_first a_i /\
  le a_i a_last /\
  le b_first b_i /\
  le b_i b_last /\
  ((bool_eq a a_first a_i b b_first b_i) = Init.Datatypes.true) /\
  ((a_i = a_last) \/
   (b_i = b_last) \/
   lt a_i a_last /\
   lt b_i b_last /\
   ~ ((to_rep (get a (add a_i one))) = (to_rep (get b (add b_i one))))).
Proof.
unfold le, ule, lt, ult.
intros a b af al bf bl (H_la,(H_lb,H_e)).
pose proof (to_uint_bounds af) as H_b_af.
pose proof (to_uint_bounds al) as H_b_al.
pose proof (to_uint_bounds bf) as H_b_bf.
pose proof (to_uint_bounds bl) as H_b_bl.
repeat split.
* unfold sub, BV_Gen.sub.
  case_and_pose_proof a b af al bf bl;
  rewrite <- H_sym; auto.
* case_and_pose_proof a b af al bf bl.
* case_and_pose_proof a b af al bf bl.
* case_and_pose_proof a b af al bf bl.
* case_and_pose_proof a b af al bf bl.
* unfold bool_eq.
  case_and_pose_proof a b af al bf bl;
  [ case_on_length a b af al bf bl bf bl
  | case_on_length a b af al bf bl af al
  | case_on_length a b af al bf bl bf bl ];
  unfold array_length at 1 3;
  rewrite H_sym; rewrite Nat.compare_refl; simpl;
  apply lcp_eq; try lia;
  unfold array_length; lia.
* case_and_pose_proof a b af al bf bl.
  + destruct (lcp_next b a (array_length bf bl) bf af H_b_bnd) as [H_next | [H_next_b H_next_e]]; try lia.
    - unfold array_length in H_next at 1 3.
      right; left.
      apply to_uint_extensionality.
      lia.
    - right; right.
      unfold array_length at 1 3 in H_next_b.
      apply Z2Nat.inj_lt in H_next_b; try lia.
  + destruct (lcp_next a b (array_length af al) af bf H_a_bnd) as [H_next | [H_next_b H_next_e]]; try lia.
    - unfold array_length in H_next at 1 3.
      left.
      apply to_uint_extensionality.
      lia.
    - right; right.
      unfold array_length at 1 3 in H_next_b.
      apply Z2Nat.inj_lt in H_next_b; try lia.
  + destruct (lcp_next b a (array_length bf bl) bf af H_b_bnd) as [H_next | [H_next_b H_next_e]]; try lia.
    - unfold array_length in H_next at 1 3.
      right; left.
      apply to_uint_extensionality.
      lia.
    - right; right.
      unfold array_length at 1 3 in H_next_b.
      apply Z2Nat.inj_lt in H_next_b; try lia.
Qed.

Fixpoint array_comp (a : map.Map.map t component_type)
  (af : t) (ah : nat) (b : map.Map.map t component_type) (bf : t) (bh : nat) : Z :=
  match to_rep (a af) ?= to_rep (b bf) with
   | Eq =>
     match ah, bh with
      | O, O => 0%Z
      | S _, O => 1%Z
      | O, S _ => -1%Z
      | S an, S bn => array_comp a (add af one) an b (add bf one) bn
    end
   | Lt => -1%Z
   | Gt => 1%Z
  end.

Lemma compare_eq_length:
  forall (a:map) (b:map),
  forall (ah:nat) (bh:nat),
  forall (af:t) (bf:t),
  (array_comp a af ah b bf bh = 0)%Z -> ah = bh.
Proof.
intros a b.
(* Do the proof by induction on ah and then a case on bh.
   We could have done the opposite. *)
induction ah.
+ intros bh af bf; case bh; auto.
  intros bn; unfold array_comp; fold array_comp.
  (* Case analysis on a af = b bf.
     All cases are simple, as the hypothesis is trivially false. *)
  case (to_rep (a af) ?= to_rep (b bf))%Z; simpl;
  intros C; contradict C; lia.
+ intros bh af bf; case bh; unfold array_comp; fold array_comp.
  (* Case analysis on a af = b bf.
     All cases are simple, as the hypothesis is trivially false. *)
  * case (to_rep (a af) ?= to_rep (b bf))%Z; simpl;
    intros C; contradict C; lia.
  (* Case analysis on a af = b bf.
     Solve simple cases directly. *)
  * intros bn; case (to_rep (a af) ?= to_rep (b bf))%Z; simpl;
    try (intros C; contradict C; lia).
    (* Apply the induction hypothesis *)
    intros H_comp; rewrite (IHah _ _ _ H_comp); auto.
Qed.

Lemma compare_eq_array_eq:
  forall (a:map) (b:map),
  forall (h:nat),
  forall (af:t) (bf:t),
  (array_comp a af h b bf h = 0)%Z <-> array_eq a af b bf h = true.
Proof.
intros a b.
(* Do the proof by induction on h *)
induction h.
+ intros af bf; unfold array_comp; fold array_comp;
  unfold array_eq; fold array_eq.
  (* Case analysis on a af = b bf.
     All cases are simple, either the hypothesis is
     trivially false or the conclusion is trivially true. *)
  case (to_rep (a af) ?= to_rep (b bf))%Z; simpl;
  split; try (intros C; contradict C; auto; lia);
  intros _; auto.
+ intros af bf; unfold array_comp; fold array_comp;
  unfold array_eq; fold array_eq.
  (* Case analysis on a af = b bf.
     Solve simple cases directly. *)
  case (to_rep (a af) ?= to_rep (b bf))%Z; simpl;
  try (split; intros C; contradict C; auto; lia).
    (* Apply the induction hypothesis *)
  apply IHh.
Qed.

Lemma compare_lcp_lt:
  forall (a:map) (b:map),
  forall (h:nat),
  forall (ah:nat) (bh:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat (ah))%Z ->
  (to_uint bf < two_power_size - Z.of_nat (bh))%Z ->
  h <= ah /\ h <= bh /\ (h = ah \/ h = bh) ->
  (array_comp a af ah b bf bh < 0)%Z <->
  (to_rep (a af) < to_rep (b bf))%Z \/
    (to_rep (a af) = to_rep (b bf))%Z /\
      (let ai := array_lcp a af b bf h in
       let bi := array_lcp b bf a af h in
        array_length bf bi < bh /\ (array_length af ai = ah \/
         array_length af ai < h /\ (to_rep (a (add ai one)) < to_rep (b (add bi one)))%Z)).
Proof.
(* We proceed by induction over h *)
intros a b; induction h.
(* Base case *)
+ intros ah bh af bf H_a H_b.
  (* Do a case analysis on the values of ah and bh to unfold array_comp *)
  case ah; case bh;
  (* S an, S bn does not make sense, discharge it immediately *)
  try (intros an bn [_ [_ [C | C]]]; contradict C; lia);
  unfold array_comp; fold array_comp;
  (* The 3 remaining cases are handled by case analysis on a af ?= b bf *)
  [intros _ | intros n _ | intros n _];
  case_eq ((to_rep (a af) ?= to_rep (b bf))%Z);
  intros H_f; split;
  try (apply Z.compare_eq in H_f);
  try (apply z_compare_lt in H_f);
  try (apply z_compare_gt in H_f);
  (* Get rid of the cases where array_comp evaluates to false in hypothesis *)
  try (intros C; contradict C; lia);
  (* Get rid of the cases where array_comp evaluates to true in hypothesis *)
  try (intros _; lia);
  (* Get rid of the cases where the disjunction evaluates to True because af < b bf *)
  try (intros _; left; auto; fail);
  (* Get rid of the cases where the disjunction evaluates to False in hypothesis *)
  try (intros [ C | [ H_eq [ [ _ C ] | [ C _]]]]; contradict C; lia).
  (* The only remaining case is the case where a af = b bf and af is the last element of a *)
  intros _; right; split; try lia.
  split; unfold array_lcp, array_length; try lia.
+ intros ah bh af bf.
  (* Do a case analysis on the values of ah and bh to unfold array_comp.
     Only the values S an and S bn make sense. *)
  case ah; try (intros _ _ [C _]; contradict C; lia); intros an.
  case bh; try (intros _ _ [_ [C _]]; contradict C; lia); intros bn.
  intros H_a H_b H_base; unfold array_comp; fold array_comp.
  (* Do a case analysis on a af ?= b bf.
     Solve the 2 simple cases on the spot. *)
  case_eq ((to_rep (a af) ?= to_rep (b bf))%Z);
  [
   (* a af < b bf *)
   | intros H_f; split; [intros _; left; auto | intros _; lia]
   (* a af > b bf *)
   | intros H_f; apply z_compare_gt in H_f; split;
     [ intros C | intros [ C | [C _]]]; contradict C; lia].
  (* The only remaining case is the case where a af = b bf *)
  intros H_f; apply Z.compare_eq in H_f.
  (* Instantiate the induction hypothesis and destruct it *)
  assert (h <= an /\ h <= bn /\ (h = an \/ h = bn)) as H_base_next by
  (repeat split; destruct H_base as [H_ha [ H_hb [H_e | H_e]]]; try lia).
  assert ((to_uint (add af one) < two_power_size - Z.of_nat an)%Z) as H_a_next by
  reduce_to_lia.
  assert ((to_uint (add bf one) < two_power_size - Z.of_nat bn)%Z) as H_b_next by
  reduce_to_lia.
  destruct (IHh an bn (add af one) (add bf one) H_a_next H_b_next H_base_next) as [H_def H_rev].
  (* Verify the two implications separately *)
  split.
  (* array_comp -> properties *)
  * intro H_next; right.
    destruct (H_def H_next) as [ H_f_next | [ H_f_next H_last ] ];
    split; auto.
    (* First case, a (af + 1) < b (bf + 1).
       We are in the second case, there are 2 distinct elements in a and b. *)
    - (* Use the assumption to solve the matches *)
    unfold array_length; unfold array_lcp;
    rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
    pose proof H_f_next as H_f_next_alt;
    apply z_compare_lt_rev in H_f_next; rewrite H_f_next; simpl.
    (* Complete the proof *)
    lia.
    (* Second case, a (af + 1) = b (bf + 1) *)
    - unfold array_lcp; fold array_lcp.
    (* Use the assumption to solve the matches *)
    rewrite H_f_next; rewrite Z.compare_refl.
    (* Destruct the induction hypothesis.
       Try to discharge all parts automatically. *)
    destruct H_last as [H_end_b [H_end_a | [H_end_a H_lt]]];
    split; try (rewrite length_next; lia).
  (* properties -> array_comp *)
 * unfold array_lcp; fold array_lcp.
  (* Reason by case on (a (af + 1) ?= b (bf + 1));
     discharge the cases where a (af + 1) <> b (bf + 1) directly. *)
  rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
  case_eq ((to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z); simpl;
  [
  | intros H_f_next _; apply z_compare_lt in H_f_next; apply H_rev; auto
  | intros H_f_next [ C | [ _ [ _ [ C | [ _ C ]]]]]; apply z_compare_gt in H_f_next;
    contradict C; try lia; unfold array_length; rewrite Zminus_diag; lia ].
  (* Remaining case: a (af + 1) = b (bf + 1).
     Destruct the hypothesis.
     Split the goal and try to discharge all parts automatically. *)
  intros H_f_next [ C | [ _ [ H_end_b [ H_end_a | [ H_end_a H_comp ]]]]];
  apply Z.compare_eq in H_f_next;
  try (contradict C; lia);
  rewrite length_next in H_end_a by lia;
  rewrite length_next in H_end_b by lia;
  apply H_rev; right; repeat split; try lia.
Qed.

Lemma compare_lcp_gt:
  forall (a:map) (b:map),
  forall (h:nat),
  forall (ah:nat) (bh:nat),
  forall (af:t) (bf:t),
  (to_uint af < two_power_size - Z.of_nat (ah))%Z ->
  (to_uint bf < two_power_size - Z.of_nat (bh))%Z ->
  h <= ah /\ h <= bh /\ (h = ah \/ h = bh) ->
  (0 < array_comp a af ah b bf bh)%Z <->
  (to_rep (a af) > to_rep (b bf))%Z \/
    (to_rep (a af) = to_rep (b bf))%Z /\
      (let ai := array_lcp a af b bf h in
       let bi := array_lcp b bf a af h in
        array_length af ai < ah /\ (array_length bf bi = bh \/
         array_length bf bi < h /\ (to_rep (a (add ai one)) > to_rep (b (add bi one)))%Z)).
Proof.
(* We proceed by induction over h *)
intros a b; induction h.
(* Base case *)
+ intros ah bh af bf H_a H_b.
  (* Do a case analysis on the values of ah and bh to unfold array_comp *)
  case ah; case bh;
  (* S an, S bn does not make sense, discharge it immediately *)
  try (intros an bn [_ [_ [C | C]]]; contradict C; lia);
  unfold array_comp; fold array_comp;
  (* The 3 remaining cases are handled by case analysis on a af ?= b bf *)
  [intros _ | intros n _ | intros n _];
  case_eq ((to_rep (a af) ?= to_rep (b bf))%Z);
  intros H_f; split;
  try (apply Z.compare_eq in H_f);
  try (apply z_compare_lt in H_f);
  try (apply z_compare_gt in H_f);
  (* Get rid of the cases where array_comp evaluates to false in hypothesis *)
  try (intros C; contradict C; lia);
  (* Get rid of the cases where array_comp evaluates to true in hypothesis *)
  try (intros _; lia);
  (* Get rid of the cases where the disjunction evaluates to True because af < b bf *)
  try (intros _; left; auto; fail);
  (* Get rid of the cases where the disjunction evaluates to False in hypothesis *)
  try (intros [ C | [ H_eq [ [ _ C ] | [ C _]]]]; contradict C; lia).
  (* The only remaining case is the case where a af = b bf and af is the last element of a *)
  intros _; right; split; try lia.
  split; unfold array_lcp, array_length; try lia.
+ intros ah bh af bf.
  (* Do a case analysis on the values of ah and bh to unfold array_comp.
     Only the values S an and S bn make sense. *)
  case ah; try (intros _ _ [C _]; contradict C; lia); intros an.
  case bh; try (intros _ _ [_ [C _]]; contradict C; lia); intros bn.
  intros H_a H_b H_base; unfold array_comp; fold array_comp.
  (* Do a case analysis on a af ?= b bf.
     Solve the 2 simple cases on the spot. *)
  case_eq ((to_rep (a af) ?= to_rep (b bf))%Z);
  [
   (* a af < b bf *)
   | intros H_f; apply z_compare_lt in H_f; split;
     [ intros C | intros [ C | [C _]]]; contradict C; lia
   (* a af > b bf *)
   | intros H_f; split; [intros _; left; auto | intros _; lia]].
  (* The only remaining case is the case where a af = b bf *)
  intros H_f; apply Z.compare_eq in H_f.
  (* Instantiate the induction hypothesis and destruct it *)
  assert (h <= an /\ h <= bn /\ (h = an \/ h = bn)) as H_base_next by
  (repeat split; destruct H_base as [H_ha [ H_hb [H_e | H_e]]]; try lia).
  assert ((to_uint (add af one) < two_power_size - Z.of_nat an)%Z) as H_a_next by
  reduce_to_lia.
  assert ((to_uint (add bf one) < two_power_size - Z.of_nat bn)%Z) as H_b_next by
  reduce_to_lia.
  destruct (IHh an bn (add af one) (add bf one) H_a_next H_b_next H_base_next) as [H_def H_rev].
  (* Verify the two implications separately *)
  split.
  (* array_comp -> properties *)
  * intro H_next; right.
    destruct (H_def H_next) as [ H_f_next | [ H_f_next H_last ] ];
    split; auto.
    (* First case, a (af + 1) < b (bf + 1).
       We are in the second case, there are 2 distinct elements in a and b. *)
    - (* Use the assumption to solve the matches *)
    unfold array_length; unfold array_lcp;
    rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
    pose proof H_f_next as H_f_next_alt;
    apply z_compare_gt_rev in H_f_next; rewrite H_f_next; simpl.
    (* Complete the proof *)
    lia.
    (* Second case, a (af + 1) = b (bf + 1) *)
    - unfold array_lcp; fold array_lcp.
    (* Use the assumption to solve the matches *)
    rewrite H_f_next; rewrite Z.compare_refl.
    (* Destruct the induction hypothesis.
       Try to discharge all parts automatically. *)
    destruct H_last as [H_end_b [H_end_a | [H_end_a H_lt]]];
    split; try (rewrite length_next; lia).
  (* properties -> array_comp *)
 * unfold array_lcp; fold array_lcp.
  (* Reason by case on (a (af + 1) ?= b (bf + 1));
     discharge the cases where a (af + 1) <> b (bf + 1) directly. *)
  rewrite (Z.compare_antisym (to_rep (a (add af one))) (to_rep (b (add bf one)))).
  case_eq ((to_rep (a (add af one)) ?= to_rep (b (add bf one)))%Z); simpl;
  [
  | intros H_f_next [ C | [ _ [ _ [ C | [ _ C ]]]]]; apply z_compare_lt in H_f_next;
    contradict C; try lia; unfold array_length; rewrite Zminus_diag; lia
  | intros H_f_next _; apply z_compare_gt in H_f_next; apply H_rev; auto ].
  (* Remaining case: a (af + 1) = b (bf + 1).
     Destruct the hypothesis.
     Split the goal and try to discharge all parts automatically. *)
  intros H_f_next [ C | [ _ [ H_end_b [ H_end_a | [ H_end_a H_comp ]]]]];
  apply Z.compare_eq in H_f_next;
  try (contradict C; lia);
  rewrite length_next in H_end_a by lia;
  rewrite length_next in H_end_b by lia;
  apply H_rev; right; repeat split; try lia.
Qed.

(* Why3 goal *)
Definition compare : map -> t -> t -> map -> t -> t -> Numbers.BinNums.Z.
Proof.
  exact (fun a af al b bf bl =>
    match (to_uint af ?= to_uint al)%Z, (to_uint bf ?= to_uint bl)%Z with
      | Gt, Gt => (0)%Z
      | Gt, _  => (-1)%Z
      | _, Gt  => (1)%Z
      | _, _   => array_comp a af (array_length af al) b bf (array_length bf bl)
    end).
Defined.

(* Why3 goal *)
Lemma compare_def_eq :
  forall (a:map) (b:map),
  forall (a_first:t) (a_last:t) (b_first:t) (b_last:t),
  ((compare a a_first a_last b b_first b_last) = 0%Z) <->
  ((bool_eq a a_first a_last b b_first b_last) = Init.Datatypes.true).
Proof.
intros a b af al bf bl.
unfold compare, bool_eq.
split.
+ case_eq (to_uint af ?= to_uint al)%Z; intro H_empty_a;
  case_eq (to_uint bf ?= to_uint bl)%Z; intro H_empty_b;
  intro H_comp; try (contradict H_comp; lia); auto;
  pose proof (compare_eq_length _ _ _ _ _ _ H_comp) as H_lgth;
  rewrite <- H_lgth;
  rewrite Nat.compare_refl;
  apply compare_eq_array_eq;
  rewrite <- H_lgth in H_comp; auto.
+ case_eq (to_uint af ?= to_uint al)%Z; intro H_empty_a;
  case_eq (to_uint bf ?= to_uint bl)%Z; intro H_empty_b;
  try (intro H_comp; contradict H_comp; auto; fail); try lia;
  case_eq (array_length af al ?= array_length bf bl); intros H_lgth;
  try (intros C; contradict C; auto; fail);
  apply Nat.compare_eq in H_lgth;
  rewrite <- H_lgth;
  intros H_eq; apply compare_eq_array_eq; auto.
Qed.

(* Tactic to prove the equivalence between the formulation
   of the definition of compare used in compare_lcp_? and
   compare_def_? *)
Ltac prove_one_equivalence H_def H_rev :=
  (* Prove both directions separately *)
  split;
  [ intros H_comp;
    (* Discard the parts of the goal which deal with empty arrays *)
    split; try lia; right; split; try lia;
    (* Apply H_def *)
      apply H_def in H_comp;
    (* Destruct H_comp and prove the goal by parts *)
    destruct H_comp as [ H_f | [ H_f [ H_end_b [ H_end_a | [ H_end_a H_f_last ]]]]];
    [ left; lia | | ]; right;
     repeat split; try (unfold array_length; unfold array_length in H_end_b;
     unfold array_length in H_end_a; lia);
    [ left; apply to_uint_extensionality; apply Z2Nat.inj in H_end_a; try lia
    | right; split; unfold array_length in H_end_a at 1 3; lia ]
 (* Discard the parts of the hypothesis which deal with empty arrays *)
 | intros [ _ [ C | [ _ H_comp ]]]; [ contradict C; lia |];
    (* Apply H_rev *)
   apply H_rev;
    (* Destruct H_comp and prove the goal by parts *)
   destruct H_comp as [ H_f | [ H_f [ H_end_b [ H_end_a | [ H_end_a H_f_last ]]]]];
    [ left; lia | | ]; right; split; try lia; split; unfold array_length at 1 3; try lia;
    [ left; rewrite H_end_a; lia
    | right; split; try lia; unfold array_length at 1 3; lia ]].

(* Why3 goal *)
Lemma compare_def_lt :
  forall (a:map) (b:map),
  forall (a_first:t) (a_last:t) (b_first:t) (b_last:t),
  ((compare a a_first a_last b b_first b_last) < 0%Z)%Z <->
  le b_first b_last /\
  (lt a_last a_first \/
   le a_first a_last /\
   (rep_lt (to_rep (get a a_first)) (to_rep (get b b_first)) \/
    ((to_rep (get a a_first)) = (to_rep (get b b_first))) /\
    (let a_i := lcp a a_first a_last b b_first b_last in
     let b_i := lcp b b_first b_last a a_first a_last in
     lt b_i b_last /\
     ((a_i = a_last) \/
      lt a_i a_last /\
      rep_lt (to_rep (get a (add a_i one))) (to_rep (get b (add b_i one))))))).
Proof.
intros a b af al bf bl.
unfold compare, le, ule, lt, ult, rep_lt, get.
pose proof (to_uint_bounds af) as H_b_af.
pose proof (to_uint_bounds al) as H_b_al.
pose proof (to_uint_bounds bf) as H_b_bf.
pose proof (to_uint_bounds bl) as H_b_bl.

(* Prove the property for non-empty arrays *)
assert
((to_uint af <= to_uint al)%Z ->
 (to_uint bf <= to_uint bl)%Z ->
  (array_comp a af (array_length af al) b bf (array_length bf bl) < 0)%Z <->
    (to_uint bf <= to_uint bl)%Z /\
    ((to_uint al < to_uint af)%Z \/
     (to_uint af <= to_uint al)%Z /\
     ((to_rep (a af) < to_rep (b bf))%Z \/
      to_rep (a af) = to_rep (b bf) /\
      (to_uint (lcp b bf bl a af al) < to_uint bl)%Z /\
      (lcp a af al b bf bl = al \/
       (to_uint (lcp a af al b bf bl) < to_uint al)%Z /\
       (to_rep (a (add (lcp a af al b bf bl) one)) < to_rep (b (add (lcp b bf bl a af al) one)))%Z))))
as H_normal_case.
{ intros H_empty_a H_empty_b.
  (* Do a case analysis on the value of array_length af al ?= array_length bf bl
     to unfold lcp. *)
  unfold lcp; case_and_pose_proof a b af al bf bl;
  (* Instantiate the lemma compare_lcp_lt with the correct values *)
  [ destruct (compare_lcp_lt a b (array_length bf bl) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev]
  | destruct (compare_lcp_lt a b (array_length af al) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev]
  | destruct (compare_lcp_lt a b (array_length bf bl) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev] ];
    try (unfold array_length; lia);
  (* For the Eq case, rewrite the first occurrence of array_length bf bl in array_comp *)
   [ apply Z2Nat.inj in H_length; try lia;
     unfold array_length at 1;
     rewrite <- H_length at 1
   | | ];
  (* discharge the 3 cases with prove_one_equivalence *)
  prove_one_equivalence H_def H_rev. }

(* Case analysis on whether a and b are empty *)
case_eq (to_uint af ?= to_uint al)%Z; intro H_empty_a;
case_eq (to_uint bf ?= to_uint bl)%Z; intro H_empty_b.
(* Normal case *)
* apply Z.compare_eq in H_empty_a;
  apply Z.compare_eq in H_empty_b.
  apply H_normal_case; lia.
(* Normal case *)
* apply Z.compare_eq in H_empty_a;
  apply z_compare_lt in H_empty_b.
  apply H_normal_case; lia.
(* Degenerated case, b is empty *)
* apply z_compare_gt in H_empty_b;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
(* Normal case *)
* apply Z.compare_eq in H_empty_b;
  apply z_compare_lt in H_empty_a.
  apply H_normal_case; lia.
* apply z_compare_lt in H_empty_a;
  apply z_compare_lt in H_empty_b.
  apply H_normal_case; lia.
(* Degenerated case, b is empty *)
* apply z_compare_gt in H_empty_b;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
(* Degenerated case, a is empty *)
* apply z_compare_gt in H_empty_a;
  apply Z.compare_eq in H_empty_b;
  split; [intros _; split; [lia | left; lia] | lia].
(* Degenerated case, a is empty *)
* apply z_compare_gt in H_empty_a;
  apply z_compare_lt in H_empty_b;
  split; [intros _; split; [lia | left; lia] | lia].
(* Degenerated case, b is empty *)
* apply z_compare_gt in H_empty_b;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
Qed.

(* Why3 goal *)
Lemma compare_def_gt :
  forall (a:map) (b:map),
  forall (a_first:t) (a_last:t) (b_first:t) (b_last:t),
  (0%Z < (compare a a_first a_last b b_first b_last))%Z <->
  le a_first a_last /\
  (lt b_last b_first \/
   le b_first b_last /\
   (rep_gt (to_rep (get a a_first)) (to_rep (get b b_first)) \/
    ((to_rep (get a a_first)) = (to_rep (get b b_first))) /\
    (let a_i := lcp a a_first a_last b b_first b_last in
     let b_i := lcp b b_first b_last a a_first a_last in
     lt a_i a_last /\
     ((b_i = b_last) \/
      lt b_i b_last /\
      rep_gt (to_rep (get a (add a_i one))) (to_rep (get b (add b_i one))))))).
Proof.
intros a b af al bf bl.
unfold compare, le, ule, lt, ult, rep_gt, get.
pose proof (to_uint_bounds af) as H_b_af.
pose proof (to_uint_bounds al) as H_b_al.
pose proof (to_uint_bounds bf) as H_b_bf.
pose proof (to_uint_bounds bl) as H_b_bl.

(* Prove the property for non-empty arrays *)
assert
((to_uint af <= to_uint al)%Z ->
 (to_uint bf <= to_uint bl)%Z ->
  (0 < array_comp a af (array_length af al) b bf (array_length bf bl))%Z <->
    (to_uint af <= to_uint al)%Z /\
    ((to_uint bl < to_uint bf)%Z \/
     (to_uint bf <= to_uint bl)%Z /\
     ((to_rep (a af) > to_rep (b bf))%Z \/
      to_rep (a af) = to_rep (b bf) /\
      (to_uint (lcp a af al b bf bl) < to_uint al)%Z /\
      (lcp b bf bl a af al = bl \/
        (to_uint (lcp b bf bl a af al) < to_uint bl)%Z /\
       (to_rep (a (add (lcp a af al b bf bl) one)) > to_rep (b (add (lcp b bf bl a af al) one)))%Z))))
as H_normal_case.
{ intros H_empty_a H_empty_b.
  (* Do a case analysis on the value of array_length af al ?= array_length bf bl
     to unfold lcp. *)
  unfold lcp; case_and_pose_proof a b af al bf bl;
  (* Instantiate the lemma compare_lcp_lt with the correct values *)
  [ destruct (compare_lcp_gt a b (array_length bf bl) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev]
  | destruct (compare_lcp_gt a b (array_length af al) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev]
  | destruct (compare_lcp_gt a b (array_length bf bl) (array_length af al) (array_length bf bl) af bf) as [H_def H_rev] ];
    try (unfold array_length; lia);
  (* For the Eq case, rewrite the first occurrence of array_length bf bl in array_comp *)
   [ apply Z2Nat.inj in H_length; try lia;
     unfold array_length at 1;
     rewrite <- H_length at 1
   | | ];
  (* discharge the 3 cases with prove_one_equivalence *)
  prove_one_equivalence H_def H_rev. }

(* Case analysis on whether a and b are empty *)
case_eq (to_uint af ?= to_uint al)%Z; intro H_empty_a;
case_eq (to_uint bf ?= to_uint bl)%Z; intro H_empty_b.
(* Normal case *)
* apply Z.compare_eq in H_empty_a;
  apply Z.compare_eq in H_empty_b.
  apply H_normal_case; lia.
(* Normal case *)
* apply Z.compare_eq in H_empty_a;
  apply z_compare_lt in H_empty_b.
  apply H_normal_case; lia.
(* Degenerated case, b is empty *)
* apply z_compare_gt in H_empty_b;
  apply Z.compare_eq in H_empty_a;
  split; [intros _; split; [lia | left; lia] | lia].
(* Normal case *)
* apply Z.compare_eq in H_empty_b;
  apply z_compare_lt in H_empty_a.
  apply H_normal_case; lia.
* apply z_compare_lt in H_empty_a;
  apply z_compare_lt in H_empty_b.
  apply H_normal_case; lia.
(* Degenerated case, b is empty *)
* apply z_compare_gt in H_empty_b;
  apply z_compare_lt in H_empty_a;
  split; [intros _; split; [lia | left; lia] | lia].
(* Degenerated case, a is empty *)
* apply z_compare_gt in H_empty_a;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
(* Degenerated case, a is empty *)
* apply z_compare_gt in H_empty_a;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
(* Degenerated case, a is empty *)
* apply z_compare_gt in H_empty_a;
  split; [intros C; contradict C; lia | intros [C _]; contradict C; lia].
Qed.
