(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require list.List.
Require list.Length.
Require list.Mem.
Require list.Append.
Require list.Reverse.

(* Why3 assumption *)
Inductive tree :=
  | Leaf : tree
  | Node : tree -> tree -> tree.
Axiom tree_WhyType : WhyType tree.
Existing Instance tree_WhyType.

(* Why3 assumption *)
Fixpoint depths (d:Numbers.BinNums.Z)
  (t:tree) {struct t}: Init.Datatypes.list Numbers.BinNums.Z :=
  match t with
  | Leaf => Init.Datatypes.cons d Init.Datatypes.nil
  | Node l r =>
      Init.Datatypes.app (depths (d + 1%Z)%Z l) (depths (d + 1%Z)%Z r)
  end.

Axiom depths_head :
  forall (t:tree) (d:Numbers.BinNums.Z),
  match depths d t with
  | Init.Datatypes.cons x _ => (d <= x)%Z
  | Init.Datatypes.nil => False
  end.

Axiom depths_unique :
  forall (t1:tree) (t2:tree) (d:Numbers.BinNums.Z)
    (s1:Init.Datatypes.list Numbers.BinNums.Z)
    (s2:Init.Datatypes.list Numbers.BinNums.Z),
  ((Init.Datatypes.app (depths d t1) s1) =
   (Init.Datatypes.app (depths d t2) s2)) ->
  (t1 = t2) /\ (s1 = s2).

Axiom depths_prefix :
  forall (t:tree) (d1:Numbers.BinNums.Z) (d2:Numbers.BinNums.Z)
    (s1:Init.Datatypes.list Numbers.BinNums.Z)
    (s2:Init.Datatypes.list Numbers.BinNums.Z),
  ((Init.Datatypes.app (depths d1 t) s1) =
   (Init.Datatypes.app (depths d2 t) s2)) ->
  (d1 = d2).

Axiom depths_prefix_simple :
  forall (t:tree) (d1:Numbers.BinNums.Z) (d2:Numbers.BinNums.Z),
  ((depths d1 t) = (depths d2 t)) -> (d1 = d2).

Axiom depths_subtree :
  forall (t1:tree) (t2:tree) (d1:Numbers.BinNums.Z) (d2:Numbers.BinNums.Z)
    (s1:Init.Datatypes.list Numbers.BinNums.Z),
  ((Init.Datatypes.app (depths d1 t1) s1) = (depths d2 t2)) -> (d2 <= d1)%Z.

Axiom depths_unique2 :
  forall (t1:tree) (t2:tree) (d1:Numbers.BinNums.Z) (d2:Numbers.BinNums.Z),
  ((depths d1 t1) = (depths d2 t2)) -> (d1 = d2) /\ (t1 = t2).

(* Why3 assumption *)
Fixpoint forest_depths
  (f:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type) {struct f}: 
  Init.Datatypes.list Numbers.BinNums.Z :=
  match f with
  | Init.Datatypes.nil => Init.Datatypes.nil
  | Init.Datatypes.cons (d, t) r =>
      Init.Datatypes.app (depths d t) (forest_depths r)
  end.

Axiom forest_depths_append :
  forall (f1:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type)
    (f2:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type),
  ((forest_depths (Init.Datatypes.app f1 f2)) =
   (Init.Datatypes.app (forest_depths f1) (forest_depths f2))).

(* Why3 assumption *)
Fixpoint greedy (d:Numbers.BinNums.Z) (d1:Numbers.BinNums.Z)
  (t1:tree) {struct t1}: Prop :=
  ~ (d = d1) /\
  match t1 with
  | Leaf => True
  | Node l1 _ => greedy d (d1 + 1%Z)%Z l1
  end.

(* Why3 assumption *)
Inductive g: Init.Datatypes.list (Numbers.BinNums.Z* tree)%type -> Prop :=
  | Gnil : g Init.Datatypes.nil
  | Gone :
      forall (d:Numbers.BinNums.Z) (t:tree),
      g (Init.Datatypes.cons (d, t) Init.Datatypes.nil)
  | Gtwo :
      forall (d1:Numbers.BinNums.Z) (d2:Numbers.BinNums.Z) (t1:tree)
        (t2:tree) (l:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type),
      greedy d1 d2 t2 -> g (Init.Datatypes.cons (d1, t1) l) ->
      g (Init.Datatypes.cons (d2, t2) (Init.Datatypes.cons (d1, t1) l)).

Axiom g_append :
  forall (l1:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type)
    (l2:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type),
  g (Init.Datatypes.app l1 l2) -> g l1.

Axiom depths_length :
  forall (t:tree) (d:Numbers.BinNums.Z),
  (1%Z <= (list.Length.length (depths d t)))%Z.

Axiom forest_depths_length :
  forall (l:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type),
  (0%Z <= (list.Length.length (forest_depths l)))%Z.

Axiom g_tail :
  forall (l1:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type)
    (l2:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type),
  g (Init.Datatypes.app l1 l2) -> g l2.

Require Import Lia.

(* Why3 goal *)
Theorem key_lemma :
  forall (t:tree) (l:Init.Datatypes.list (Numbers.BinNums.Z* tree)%type)
    (d:Numbers.BinNums.Z) (d1:Numbers.BinNums.Z) (t1:tree)
    (s:Init.Datatypes.list Numbers.BinNums.Z),
  (d < d1)%Z -> (1%Z <= (list.Length.length l))%Z ->
  g (Lists.List.rev (Init.Datatypes.cons (d1, t1) l)) ->
  ~ ((forest_depths (Init.Datatypes.cons (d1, t1) l)) =
     (Init.Datatypes.app (depths d t) s)).
(* Why3 intros t l d d1 t1 s h1 h2 h3. *)
Proof.
induction t; simpl.
(* t = Leaf *)
intros.
generalize (depths_head t1 d1).
destruct (depths d1 t1); intuition.
simpl in H3. injection H3.
intros; lia.
(* t = Node _ _ *)
rename t1 into left, IHt1 into IHleft,
       t2 into right, IHt2 into IHright.
destruct l.
(* l = Nil *)
simpl; intros; lia.
(* l = Cons _ *)
destruct p as (d2, t2).
intros d d1 t1 s hdd1 hlen hg.
assert (hg2: g (app (List.rev l) (cons (d2, t2) nil))).
  simpl in hg. apply g_append with ((d1,t1)::nil)%list. assumption.
assert (hg12: g (app (cons (d2, t2) nil) (cons (d1, t1) nil))).
  simpl in hg. rewrite <- Append.Append_assoc in hg.
  apply g_tail with (List.rev l); assumption.
inversion hg12. subst. clear H5.
assert (ineq: (d1 <> d2)).
  destruct t2; simpl in H1; lia.
intros eq.
assert (case: (d2 < d1 \/ d1 < d2)%Z) by lia. destruct case as [case|case].
(* d2 < d1 *)
assert (L0: (forall t2 d1 d2, greedy d1 d2 t2 -> d2 < d1 ->
   match depths d2 t2 with cons x _ => x < d1 | Nil  => False end)%Z).
  induction t0.
  simpl; intros; lia.
  simpl.
  clear IHt0_2.
  intros d0 d3 (diseq, gr) lt.
  assert (d0 <> d3+1)%Z. 
    destruct t0_1; simpl in gr; lia.
  assert (d3+1 < d0)%Z.
    lia.
  generalize (IHt0_1 d0 (d3+1)%Z gr H0).
  destruct (depths (d3 + 1) t0_1).
  intuition.
  simpl; auto.
assert (L1: forall t d1 t1 l s d, (d < d1)%Z ->
  app (depths d1 t1) l = app (depths d t) s -> 
  match l with cons x _ => (x >= d1)%Z | Nil => True end).
  clear L0 case eq ineq H1 hg12 hg2 hg hlen hdd1.
  clear s t1 d1 d l t2 d2 IHright IHleft right left.
  induction t; simpl.
  intros.
  generalize (depths_head t1 d1).
  destruct (depths d1 t1).
  intuition.
  destruct l; auto.
  simpl in H0. injection H0; intros; lia.
  intros.
  assert (case2: (d+1 = d1 \/ d+1 < d1)%Z) by lia. destruct case2.
  rewrite H1 in *.
  assert (l = app (depths d1 t2) s).
    rewrite <- Append.Append_assoc in H0.
    generalize (depths_unique _ _ _ _ _ H0); intros; intuition.
  generalize (depths_head t2 d1).
  subst l. destruct (depths d1 t2).
  intuition. simpl. lia. 
  clear IHt2.
  apply (IHt1 d1 t0 l (app (depths (d+1) t2) s) (d+1))%Z; auto.
  rewrite Append.Append_assoc; assumption.

generalize eq.
pose (l0 := (app (depths d2 t2) (forest_depths l))).
generalize (depths_head t2 d2).
generalize (L0 t2 d1 d2 H1 case); clear L0.
generalize (L1 (Node left right) d1 t1 l0 s d hdd1 eq).
subst l0.
destruct (depths d2 t2).
intuition.
simpl.
intros; lia.

(* d1 < d2 *)
assert (case2: (d+1 = d1 \/ d+1 < d1)%Z) by lia. destruct case2.
(* d+1 = d1 *)
rewrite H in *.
assert (t1 = left).
  rewrite <- Append.Append_assoc in eq.
  generalize (depths_unique _ _ _ _ _ eq); intuition.
subst t1.
assert (forest_depths (cons (d2, t2) l) = app (depths d1 right) s).
  rewrite <- Append.Append_assoc in eq.
  generalize (depths_unique _ _ _ _ _ eq); intuition.
clear eq.
destruct l.
(* l = Nil => contradiction *)
simpl in H0.
assert (d1 >= d2)%Z.
  rewrite Append.Append_l_nil in H0. symmetry in H0.
  generalize (depths_subtree _ _ _ _ _ H0); lia.
lia.
(* l = Cons _ _ *)
clear IHleft.
apply (IHright (cons p l) d1 d2 t2 s); auto.
replace (Length.length (p::l)) with (1+Length.length l)%Z.
  generalize (Length.Length_nonnegative l).
  lia.
  trivial.
(* d+1 < d1 *)
clear IHright.
apply (IHleft (cons (d2, t2) l) (d+1) d1 t1 (app (depths (d+1) right) s))%Z; auto.
simpl. simpl in eq. rewrite <- Append.Append_assoc in eq. assumption.
Qed.

