Require Import GHC.Base.
Import GHC.Base.Notations.
Require Import Proofs.GHC.Base.
Require Import Data.Map.Internal.
Import GHC.Num.Notations.
Require Import OrdTactic.
Require Import Psatz.
Require Import Tactics.
Set Bullet Behavior "Strict Subproofs".
Require Import MapProofs.Bounds.
Require Import MapProofs.Tactics.
Require Export MapProofs.PairTypeclass.

Section WF.
Context {e : Type} {a : Type} {HEq : Eq_ e} {HOrd : Ord e} {HEqLaws : EqLaws e}  {HOrdLaws : OrdLaws e}.

(** ** Verification of [foldrWithKey] *)

Lemma fold_right_toList_go:
  forall f (n : a) map (xs : list (e * a)),
  fold_right f n (foldrWithKey (fun x y t  => (x,y) :: t) xs map) =
  foldrWithKey (fun x y t => f (x,y) t) (fold_right f n xs) map.
Proof.
  intros. generalize dependent xs. induction map.
  - intros. simpl. rewrite IHmap1. simpl. rewrite IHmap2. reflexivity.
  - simpl. intros. reflexivity.
Qed.

Lemma foldrWithKey_spec:
  forall f (n : a) map,
  foldrWithKey f n map = fold_right (fun (x : e * a) t => let (a0, b0) := x in f a0 b0 t) n (toList map).
Proof.
  intros. unfold toList. unfold toAscList. rewrite fold_right_toList_go. simpl. reflexivity.
Qed.

(** ** Verification of [foldr] *)
Lemma foldr_spec:
  forall f (n: a) (map : Map e a),
  foldr f n map = foldrWithKey (fun x y t => f y t) n map.
Proof.
  intros. generalize dependent n. induction map.
  - intros. simpl. rewrite IHmap1. rewrite IHmap2. reflexivity.
  - intros. simpl. reflexivity.
Qed.

(** ** Verification of [foldr'] *)
Lemma foldr'_spec:
  forall {k : Type} (f : a -> k -> k) (n : k) (m : Map e a),
  foldr' f n m = foldr f n m.
Proof. reflexivity. Qed.

(** ** Verification of [toList] *)

Lemma foldrWithKey_const_append:
  forall xs (map : Map e a),
  foldrWithKey (fun x y t => (x,y) :: t) xs map = toList map ++ xs.
Proof.
  intros. generalize dependent xs. induction map; intros.
  - unfold toList, toAscList in *. simpl. rewrite IHmap1. rewrite IHmap2.
    rewrite (IHmap1 ((k, a0) :: foldrWithKey (fun (k0 : e) (x : a) (xs0 : list (e * a)) => (k0, x) :: xs0) nil map2)).
    rewrite <- app_assoc. reflexivity.
  - simpl. reflexivity.
Qed.

(*Allows us to decompose toList*)
Lemma toList_Bin:
  forall sz key value (m1 m2 : Map e a),
  toList (Bin sz key value m1 m2) = toList m1 ++ (key, value) :: nil ++ toList m2.
Proof.
  intros.
  unfold toList. unfold toAscList. simpl.
  rewrite foldrWithKey_const_append. rewrite foldrWithKey_const_append.
  rewrite foldrWithKey_const_append. rewrite app_nil_r. rewrite app_nil_r.
  reflexivity.
Qed.

(*We have two different versions of toList_sem for use in proving [Eq], preceded by several helper lemmas*)

(*This function imposes a stronger condition than List.elem - the values must be equal according to Coq.
This is used in proving strong equality*)
Fixpoint Key_In {e} {a} `{EqLaws e} (key : e) (value : a) (l : list (e * a)) : Prop :=
  match l with
  | nil => False
  | a :: tl => (let (x,y):= a in x == key = true /\ y = value) \/ Key_In key value tl
  end.

(*Helper methods for logic*)

Lemma or_assoc: forall b1 b2 b3,
  (b1 \/ b2) \/ b3 <-> b1 \/ ( b2 \/ b3).
Proof.
  intros. split; intros.
  - destruct H. destruct H. left. assumption. right. left. assumption. right.
    right. assumption.
  - destruct H. left. left. assumption. destruct H. left. right. assumption. right.
    assumption.
Qed.

Lemma false_or: forall (P : Prop),
  False \/ P <-> P.
Proof.
  intros. split; intros.
  - destruct H. destruct H. apply H.
  - right. apply H.
Qed.

(*Key property of Key_In for lists - if we append to 2 lists, an item is in the whole list
iff it is in one of them*)
Lemma elem_or : forall {e} {a} `{EqLaws e} (key : e) (value : a) l1 l2,
  Key_In key value (l1 ++ l2) <-> Key_In key value l1 \/ Key_In key value l2.
Proof.
  intros. generalize dependent l2. induction l1.
  - intros. simpl. split; intros.
    + right. assumption.
    + destruct H1. destruct H1. assumption.
  - intros. simpl. rewrite IHl1. rewrite or_assoc. apply iff_refl.
Qed.

(*The first toList_sem:
This says that sem m key returns a Value iff that key, value pair appears in the
resulting toList of the map (according to Coq equality for values)*)

Lemma toList_sem :
  forall  (m: Map e a) lb ub, Bounded m lb ub ->
  forall key value, sem m key = Some value <-> Key_In key value (toList m).
Proof.
  intros. generalize dependent value. induction H.
  - simpl. intros. split; intros. discriminate H. destruct H.
  - intros. simpl. rewrite toList_Bin. rewrite elem_or.
    assert (((x, v) :: nil ++ toList s2) = (((x, v) :: nil) ++ toList s2)).
    simpl. reflexivity. rewrite H5. rewrite elem_or. split; intros.
      + destruct (sem s1 key) eqn : ?; simpl in H6.
      * apply IHBounded1 in H6. left. apply H6.
      * destruct (key == x) eqn : ?; simpl in H6.
        { right. left. simpl. left. apply Eq_Symmetric in Heqb.
          split. apply Heqb. inversion H6. reflexivity. }
        { apply IHBounded2 in H6. right. right. assumption. }
     + destruct H6.
      * apply IHBounded1 in H6. rewrite H6. simpl. reflexivity.
      * destruct H6. simpl in H6. destruct H6. destruct H6.
        assert (sem s1 key = None). { eapply sem_outside_above.
        apply H. order_Bounds e. }
        rewrite H8. simpl. apply Eq_Symmetric in H6. rewrite H6. simpl.
        rewrite H7. reflexivity. destruct H6. apply IHBounded2 in H6.
        assert (key > x = true ) by (solve_Bounds e).
        assert (sem s1 key = None). eapply sem_outside_above. eassumption.
        solve_Bounds e. rewrite H8. replace (key == x) with false by (order e).
        rewrite H6. reflexivity.
Qed.

(*Helper lemmas for [toList_sem']*)
(*Analogue of [elem_or] for List.elem*)
Lemma list_elem_or : forall `{Eq_ a} `{EqLaws a} l1 l2 (x : e * a),
  List.elem x (l1 ++ l2) = List.elem x l1 || List.elem x l2.
Proof.
  intros. generalize dependent l2. induction l1; intros.
  - destruct l2. simpl. reflexivity. simpl. reflexivity.
  - destruct l2. simpl. rewrite app_nil_r. rewrite orb_false_r .
    reflexivity. simpl. rewrite IHl1. rewrite orb_assoc. simpl. reflexivity.
Qed.

(*Weaker version of [toList_sem], using Haskell equality instead of Coq's. sem m key == Some value
iff the (key, value) pair appears in toList*)
Lemma toList_sem' :
  forall `{Eq_ a} `{EqLaws a}  m lb ub, Bounded m lb ub ->
  forall key value, sem m key == Some value = true <->
     List.elem (key, value) (toList m) = true.
Proof.
  intros. generalize dependent value. induction H2.
  - simpl. intros. split; intros.
    + discriminate H2.
    + discriminate H2.
  - intros; split; intros; simpl.
    + rewrite toList_Bin. simpl. rewrite list_elem_or. simpl.
      simpl in H6. destruct (List.elem (key, value) (toList s1)) eqn : ?.
      * simpl. reflexivity.
      * simpl. specialize (IHBounded1 value). destruct IHBounded1.
        apply contrapositive in H7. destruct (sem s1 key) eqn : ?.
        { simpl in H6. contradiction. }
        { simpl in H6. destruct (_GHC.Base.==_ (key, value) (x, v)) eqn : ?.
          { simpl. reflexivity. }
          { simpl. rewrite eq_tuple_eq in Heqb0.
            rewrite andb_false_iff in Heqb0. destruct Heqb0.
            { rewrite H9 in H6. simpl in H6. apply IHBounded2. apply H6. }
            { destruct (_GHC.Base.==_ key x) eqn : ?.
              { simpl in H6. rewrite simpl_option_some_eq in H6.
                apply Eq_Symmetric in H6. unfold is_true in H6.
                rewrite H9 in H6. discriminate H6. }
              { simpl in H6. apply IHBounded2. assumption. }
            }
          }
        }
        { destruct (List.elem (key, value) (toList s1)). discriminate Heqb.
          intro. discriminate H9. }
    + rewrite toList_Bin in H6. simpl in H6. rewrite list_elem_or in H6.
      rewrite orb_true_iff in H6. destruct H6.
      * apply IHBounded1 in H6. destruct (sem s1 key) eqn : ?.
        { simpl. assumption. }
        { discriminate H6. }
      * simpl in H6. rewrite orb_true_iff in H6. destruct H6.
        { assert (forall i, sem s1 key <> Some i). { rewrite eq_tuple_prop in H6.
          destruct H6. intros. intro. solve_Bounds e. }
          assert (sem s1 key = None). { destruct (sem s1 key). specialize (H7 a0).
          contradiction. reflexivity. }
          rewrite H8. simpl. rewrite eq_tuple_prop in H6. destruct H6.
          rewrite H6. simpl. rewrite simpl_option_some_eq. apply Eq_Symmetric.
          apply H9. }
        { apply IHBounded2 in H6. destruct (sem s2 key) eqn : ?.
          assert (sem s1 key = None). { apply (sem_inside H2_0) in Heqo.
          destruct Heqo. eapply sem_outside_above. apply H2_. order_Bounds e. }
          rewrite H7. simpl. assert (key == x = false) by solve_Bounds e. rewrite H8.
          simpl. assumption. discriminate H6. }
Qed.

(*Equality based (rather than prop based) version of the above*)
Lemma toList_sem'_eq :
  forall `{Eq_ a} `{EqLaws a}  m lb ub, Bounded m lb ub ->
  forall key value, sem m key == Some value = List.elem (key, value) (toList m).
Proof.
  intros. rewrite prop_bool.  eapply toList_sem'. apply H2.
Qed.

(*The next two lemmas say that every key in toList m is between the bounds of the map*)
Lemma toList_lb : forall m lb ub,
  Bounded m lb ub ->
  Forall (fun (i : e * a) => let (x, _) := i in isLB lb x = true) (toList m).
Proof.
  intros. induction H.
  - apply Forall_nil.
  - rewrite toList_Bin. rewrite Forall_forall in *.
    intros. simpl in H5. rewrite in_app_iff in *.
    destruct H5.
    + apply IHBounded1. assumption.
    +  simpl in H5.  destruct H5.
      *  subst.  assumption.
      * apply IHBounded2 in H5. simpl in H5. rename x0 into x2.
        destruct x2. order_Bounds e.
Qed.

Lemma toList_ub : forall m lb ub,
  Bounded m lb ub ->
  Forall (fun (i : e * a) => let (x, _) := i in isUB ub x = true) (toList m).
Proof.
  intros. induction H.
  - apply Forall_nil.
  - rewrite toList_Bin. rewrite Forall_forall in *. intros.
    simpl in H5. rewrite in_app_iff in *. destruct H5.
    + apply IHBounded1 in H5. destruct x0. order_Bounds e.
    + simpl in H5. destruct H5. subst. assumption. apply IHBounded2. assumption.
Qed.

(*The list of the empty tree is empty*)
Lemma toList_Tip: toList (@Tip e a) = nil.
Proof. reflexivity. Qed.

(*The list contains the left subtree, then the current value, then the right subtree
(crucial in showing that the list is sorted)*)
Lemma toList_bin:
  forall key value n (m1 m2 : Map e a),
  toList (Bin n key value m1 m2) = toList m1 ++ ((key, value) :: nil) ++ toList m2.
Proof. intros. apply toList_Bin. Qed.

(*The next two lemmas prove that the list from toList is in the same order even if we balance the tree. The
proofs are very similar to setProofs, only 1 more case at the end*)
Lemma toList_balanceR :
  forall x y (m1: Map e a) m2 lb ub,
  Bounded m1 lb (Some x) ->
  Bounded m2 (Some x) ub ->
  balance_prop (size m1) (size m2) \/
  balance_prop_inserted (size m2 - 1) (size m1) /\ (1 <= size m2)%Z  \/
  balance_prop (size m1 + 1) (size m2) ->
  toList (balanceR x y m1 m2) = toList m1 ++ ((x,y) :: nil) ++ toList m2.
Proof.
  intros.
  unfold balanceR.
  unfold op_zg__, op_zl__, Ord_Integer___, op_zg____, op_zl____.

  repeat lazymatch goal with [ H : Bounded ?s _ _ |- context [match ?s with _ => _ end] ] => inversion H; subst; clear H end;
  repeat lazymatch goal with [ |- context [if (?x <? ?y)%Z then _ else _] ] => destruct (Z.ltb_spec x y) end;
  rewrite ?size_Bin in *; simpl (size Tip) in *; simpl sem;
  simpl isLB in *;
  simpl isUB in *.
  all: try solve [exfalso; lia_sizes]. (* Some are simply impossible *)
  all: repeat find_Tip.
  all: rewrite ?toList_Bin, <- ?app_assoc; try reflexivity.
  simpl. rewrite <- app_assoc. simpl. reflexivity. simpl. rewrite <-app_assoc. simpl.
  reflexivity.
Qed.

Lemma toList_balanceL:
  forall x y (m1: Map e a) m2 lb ub,
  Bounded m1 lb (Some x) ->
  Bounded m2 (Some x) ub  ->
  balance_prop (size m1) (size m2) \/
  balance_prop_inserted (size m1 - 1) (size m2) /\ (1 <= size m1)%Z \/
  balance_prop (size m1) (size m2 + 1) ->
  toList (balanceL x y m1 m2) = toList m1 ++ ((x, y) :: nil) ++ toList m2.
Proof.
  intros.
  unfold balanceL.
  unfold op_zg__, op_zl__, Ord_Integer___, op_zg____, op_zl____.

  repeat lazymatch goal with [ H : Bounded ?s _ _ |- context [match ?s with _ => _ end] ] => inversion H; subst; clear H end;
  repeat lazymatch goal with [ |- context [if (?x <? ?y)%Z then _ else _] ] => destruct (Z.ltb_spec x y) end;
  rewrite ?size_Bin in *; simpl (size Tip) in *; simpl sem;
  simpl isLB in *;
  simpl isUB in *.
  all: try solve [exfalso; lia_sizes]. (* Some are simply impossible *)
  all: repeat find_Tip.
  all: rewrite ?toList_Bin, <- ?app_assoc; try reflexivity.
  all: simpl; rewrite <- app_assoc; reflexivity.
Qed.

(*If we insertMax into a tree, that value is at the end of the list*)
Lemma toList_insertMax:
   forall x y (m: Map e a) lb,
   Bounded m lb (Some x) ->
   toList (insertMax x y m) = toList m ++ (x,y) :: nil.
Proof.
  intros. remember (Some x) as ub'. generalize dependent x.
  induction H; intros.
  - simpl. reflexivity.
  - simpl. subst. specialize(IHBounded2 x0 eq_refl). revert IHBounded2.
    assert (isUB None x0 = true) by reflexivity. applyDesc e (@insertMax_Desc e a).
    intro. erewrite toList_balanceR. rewrite IHBounded2. rewrite toList_bin.
    rewrite <- app_assoc. simpl. reflexivity. apply H. apply HB.
    solve_size.
Qed.

(*If we insertMin into a tree, that value is at the beginning of the list*)
Lemma toList_insertMin:
   forall x y (m: Map e a) ub,
   Bounded m (Some x) ub ->
   toList (insertMin x y m) = (x,y) :: nil ++ toList m.
Proof.
  intros. remember (Some x) as ub'. generalize dependent x.
  induction H; intros.
  - simpl. reflexivity.
  - simpl. subst. specialize(IHBounded1 x0 eq_refl). revert IHBounded1.
    assert (isLB None x0 = true) by reflexivity. applyDesc e (@insertMin_Desc e a).
    intro. erewrite toList_balanceL. rewrite IHBounded1. rewrite toList_bin.
    simpl. reflexivity. apply HB. apply H0. solve_size.
Qed.

(*States that if we link 2 maps together, then the list is in the same order. These
past few lemmas together mean that when balancing the tree, the list does not change*)
Program Fixpoint toList_link (x : e) (y : a) (m1: Map e a)  (m2: Map e a)
  {measure (map_size m1 + map_size m2)} :
    forall lb ub,
    Bounded m1 lb (Some x) ->
    Bounded m2 (Some x) ub  ->
    isLB lb x = true ->
    isUB ub x = true->
    toList (link x y m1 m2) = toList m1 ++ (x,y) :: nil ++ toList m2 := _.
Next Obligation.
  intros.
  rewrite link_eq.
  inversion H; subst; clear H;
  inversion H0; subst; clear H0.
  * reflexivity.
  * erewrite toList_insertMin by solve_Bounded e.
    rewrite toList_Bin.
    reflexivity.
  * erewrite toList_insertMax by solve_Bounded e.
    rewrite toList_Bin.
    reflexivity.
  * destruct (Sumbool.sumbool_of_bool _);
    only 2: destruct (Sumbool.sumbool_of_bool _);
    rewrite ?Z.ltb_lt, ?Z.ltb_ge in *.
    - erewrite toList_balanceL; only 3: solve_Precondition e.
      erewrite toList_link by solve_Precondition e.
      rewrite ?toList_Bin, <- ?app_assoc. reflexivity.
      applyDesc e (@link_Desc e a); eassumption.
      applyDesc e (@link_Desc e a); solve_size.
    - erewrite toList_balanceR; only 2: solve_Precondition e.
      erewrite toList_link by solve_Precondition e.
      rewrite ?toList_Bin, <- ?app_assoc. reflexivity.
      applyDesc e (@link_Desc e a); eassumption.
      applyDesc e (@link_Desc e a); solve_size.
    - rewrite ?toList_bin, ?toList_Bin, <- ?app_assoc.
      unfold bin. rewrite toList_bin. rewrite toList_bin.
      rewrite toList_bin. simpl. rewrite <- app_assoc. simpl.
      reflexivity.
Qed.

(** *** Sortedness of [toList] *)

Require Import Coq.Sorting.Sorted.
Close Scope Z.

(*Maps are sorted only by keys*)
Local Definition lt : e * a -> e * a -> Prop
  := fun x1 x2 => let (e1, a1) := x1 in let (e2, a2) := x2 in (e1 < e2) = true.

(* States that if two lists are sorted and all values in the first are smaller
than all values in the second, then appending the two lists gives a sorted list. *)
Lemma sorted_append:
  forall (l1 : list (e * a)) (l2 : list (e * a)) (x : e),
  StronglySorted lt l1 ->
  StronglySorted lt l2 ->
  (forall (y : e) (z : a), List.In (y, z) l1 -> (y < x) = true) ->
  (forall y z, List.In (y, z) l2 -> (x <= y) = true) ->
  StronglySorted lt (l1 ++ l2).
Proof.
  intros ??? Hsorted1 Hsorted2 Hlt Hge.
  induction Hsorted1.
  * apply Hsorted2.
  * simpl. apply SSorted_cons.
    + apply IHHsorted1.
      intros y z Hy.
      eapply Hlt.
      right. apply Hy.
    + rewrite Forall_forall.
      intros z Hz.
      rewrite in_app_iff in Hz.
      destruct Hz.
      - rewrite Forall_forall in H.
        apply H; auto.
      - destruct a0.  assert (e0 < x = true). eapply Hlt. left. reflexivity.
        unfold lt. destruct z. apply Hge in H0. order e.
Qed.

(*Similar to List.elem, but does not require that a be in the Eq typeclass (because it doesn't actually
matter; the a's are not ever compared)*)
Fixpoint list_elem_tuple (x : e * a) (l : list (e * a)) :=
  match l with
  | nil => false
  | h :: t => let (a, b) := h in let (x1, x2) := x in (a == x1) || list_elem_tuple x t
  end.

(*This states that if x is a lower bound for a list and the tuple i is in the list, then x is less than i.
Note: this required a change from toList (using lt rather than < in the conclusion), though this
is needed because there is no definition of ordering on all tuples*)
Lemma All_lt_elem:
  forall x i xs,
  Forall (lt x) xs ->
  list_elem_tuple i xs = true ->
  lt x i.
Proof.
  intros.
  induction H.
  * simpl in H0. inversion H0.
  * simpl in *. destruct x0. destruct i.
    rewrite orb_true_iff in H0.
    destruct H0.
    - unfold lt in *. destruct x. order e.
    - intuition.
Qed.

(*toList is sorted by key*)
Lemma to_List_sorted:
  forall m lb ub,
  Bounded m lb ub ->
  StronglySorted lt (toList m).
Proof.
  intros. induction H.
  - apply SSorted_nil.
  - rewrite toList_bin. eapply sorted_append. assumption.
    apply SSorted_cons. assumption. apply toList_lb in H0.
    apply H0. apply toList_ub in H.  intros.
    rewrite Forall_forall in H.
    remember (y,z) as t.
    apply H in H5. destruct t. inversion Heqt. rewrite <- H7. unfold isUB in H5. apply H5.
    intros. simpl in H5. destruct H5.
    + inversion H5. order e.
    + apply toList_lb in H0.
      rewrite Forall_forall in H0. apply H0 in H5. order_Bounds e.
Qed.

(** ** Verification of [toAscList] *)

Lemma toAscList_spec: @toAscList = @toList. Proof. reflexivity. Qed.

(** ** Verification of [elems] *)

Lemma fold_right_with_assoc:
  forall l1 l2,
    fold_right (fun (x : e * a) acc => let (a,b) := x in b :: acc) l1 l2  =
  fold_right (fun (x : e * a) acc => let (a,b) := x in b :: acc) nil l2 ++ l1.
Proof.
  intros. generalize dependent l1. induction l2.
  - intros. simpl. reflexivity.
  - intros. simpl. destruct a0. rewrite IHl2. simpl. reflexivity.
Qed.

Lemma foldr_const_append:
  forall xs (map : Map e a),
  foldr cons xs map = elems map ++ xs.
Proof.
  intros. generalize dependent xs. induction map; intros.
  - simpl. unfold elems. simpl. rewrite IHmap1. rewrite IHmap2. rewrite IHmap1.
    rewrite IHmap2. rewrite <- app_assoc. simpl. rewrite <- app_assoc. reflexivity.
  - simpl. reflexivity.
Qed.

Lemma elems_Bin:
  forall sz key value (m1 m2 : Map e a),
  elems (Bin sz key value m1 m2) = elems m1 ++ (value :: nil) ++ elems m2.
Proof.
  intros.
  unfold elems at 1. simpl. rewrite foldr_const_append. rewrite foldr_const_append.
  rewrite app_nil_r. reflexivity.
Qed.

(*For a map, elems means we take the 2nd element of each tuple in toList*)
Lemma elems_spec: forall map,
  elems map = fold_right (fun (x : e * a) acc => let (a,b) := x in  b :: acc) nil (toList map).
Proof.
  intros. induction map.
  - rewrite elems_Bin.  rewrite IHmap1. simpl. rewrite IHmap2. rewrite toList_bin.
    rewrite fold_right_app. simpl. rewrite <- fold_right_with_assoc. reflexivity.
  - simpl. unfold elems. simpl. reflexivity.
Qed.

(** ** Verification of [keys] *)

Lemma fold_right_with_assoc':
  forall l1 l2,
    fold_right (fun (x : e * a) acc => let (a,b) := x in a :: acc) l1 l2  =
  fold_right (fun (x : e * a) acc => let (a,b) := x in a :: acc) nil l2 ++ l1.
Proof.
  intros. generalize dependent l1. induction l2.
  - intros. simpl. reflexivity.
  - intros. simpl. destruct a0. rewrite IHl2. simpl. reflexivity.
Qed.

Lemma foldrWithKey_const_append':
  forall xs (map : Map e a),
  foldrWithKey (fun x y t => x :: t) xs map = keys map ++ xs.
Proof.
  intros. generalize dependent xs. induction map; intros.
  - unfold keys in *.  simpl. rewrite IHmap1. rewrite IHmap2.
    rewrite (IHmap1 (k :: foldrWithKey (fun (arg_0__ : e) (_ : a) (arg_2__ : list e) => arg_0__ :: arg_2__) nil map2) ).
    rewrite <- app_assoc. reflexivity.
  - simpl. reflexivity.
Qed.

Lemma keys_Bin:
  forall sz key value (m1 m2 : Map e a),
  keys (Bin sz key value m1 m2) = keys m1 ++ (key :: nil) ++ keys m2.
Proof.
  intros.
  unfold keys at 1. simpl. rewrite foldrWithKey_const_append'. rewrite foldrWithKey_const_append'.
  rewrite app_nil_r. reflexivity.
Qed.

Lemma keys_spec: forall map,
  keys map = fold_right (fun (x : e * a) acc => let (a,b) := x in  a :: acc) nil (toList map).
Proof.
  intros. induction map.
  - rewrite keys_Bin.  rewrite IHmap1. simpl. rewrite IHmap2. rewrite toList_bin.
    rewrite fold_right_app. simpl. rewrite <- fold_right_with_assoc'. reflexivity.
  - simpl. unfold keys. simpl. reflexivity.
Qed.

(** ** Verification of [assocs] *)
Lemma assocs_spec: forall (map: Map e a),
  assocs map = toList map.
Proof.
  intros. unfold assocs. unfold toList. reflexivity.
Qed.

(** ** Verification of [toDescList] *)

(*The reverse of a list is empty iff the original list was empty*)
Lemma rev_nil : forall {A : Type} (x : list A),
  rev x = nil <-> x = nil.
Proof.
  intros. split; intros.
  - destruct x.
    + reflexivity.
    + simpl in H. assert (nil <> rev x ++ a0 :: nil ) by apply app_cons_not_nil.
      rewrite H in H0. contradiction.
  - rewrite H. reflexivity.
Qed.

(*Reversing a list is injective*)
Lemma rev_inj {A} (x y : list A) :
  rev x = rev y -> x = y.
Proof.
  intros. generalize dependent y. induction x using rev_ind; intros.
  - simpl in H.  symmetry. apply rev_nil. symmetry. assumption.
  - rewrite rev_app_distr in H. simpl in H. destruct y using rev_ind.
    + simpl in H. discriminate H.
    + rewrite rev_app_distr in H. simpl in H. inversion H. subst.
    apply IHx in H2. subst. reflexivity.
Qed.

(*from SetProofs, not actually useful*)
Lemma foldl_acc_app: forall l (m : Map e a),
  foldl (flip cons) l m = foldl (flip cons) nil m ++ l.
Proof.
  intros. generalize dependent l. induction m; intros.
  - simpl. rewrite IHm2. rewrite  IHm1. symmetry. rewrite IHm2. rewrite <- app_assoc.
    simpl. unfold flip. reflexivity.
  - simpl. reflexivity.
Qed.

(*The version we want for toDescList_spec*)
Lemma foldlWithKey_acc_app: forall l (m : Map e a),
  foldlWithKey (fun acc x y => (x, y) :: acc) l m = foldlWithKey (fun acc x y => (x,y) :: acc) nil m ++ l.
Proof.
  intros. generalize dependent l. induction m; intros.
  - simpl. rewrite IHm2. rewrite IHm1. symmetry. rewrite IHm2. rewrite <- app_assoc.
    reflexivity.
  - simpl. reflexivity.
Qed.

(*reversing a list takes the last element and puts it at the front*)
Lemma rev_cons: forall {A: Type} (l : list A) (x : A),
  rev (l ++ x :: nil) = x :: rev l.
Proof.
  intros. induction l.
  - simpl. reflexivity.
  - simpl. rewrite IHl. simpl. reflexivity.
Qed.

(*toDescList returns the reverse of toAscList on a map*)
Lemma toDescList_spec (map : Map e a) :
  toDescList map = rev (toAscList map).
Proof.
  unfold toDescList. unfold toAscList.
  induction map.
  - simpl. rewrite IHmap1. rewrite foldlWithKey_acc_app. rewrite IHmap2.
    assert ((k, a0) :: rev (foldrWithKey (fun (k0 : e) (x : a) (xs : list (e * a)) => (k0, x) :: xs) nil map1)=
      rev (foldrWithKey (fun (k0 : e) (x : a) (xs : list (e * a)) => (k0, x) :: xs) nil map1 ++ (k, a0) :: nil))
      by (symmetry; apply rev_cons).
    rewrite H. rewrite <- rev_app_distr.
    rewrite foldrWithKey_const_append. rewrite app_nil_r. rewrite foldrWithKey_const_append. rewrite app_nil_r.
    rewrite foldrWithKey_const_append. rewrite <- app_assoc. simpl. reflexivity.
  - simpl. reflexivity.
Qed.

(** ** Verification of [foldl] and [foldlWithKey *)

(** This relates [foldl] and [elems]. *)
Lemma foldl_spec:
  forall k (n : a) (m: Map e a),
  foldl k n m = fold_left k (elems m) n.
Proof.
  intros. generalize dependent n. induction m; intros.
  - simpl. rewrite (elems_Bin s k0 a0 m1 m2) . rewrite IHm1. rewrite IHm2.
    rewrite fold_left_app. simpl. reflexivity.
  - simpl. reflexivity.
Qed.

(*TODO: REPLACE WITH UPDATED SPEC FROM MAPFUNCTIONPROOFS*)
(** This relates [foldlWithKey] and [toList]. *)
Lemma foldlWithKey_spec:
  forall f (n : e * a) (m: Map e a),
  foldlWithKey f n m = fold_left (fun xs (x : e * a) => let (a,b) := x in f xs a b)  (toList m) n.
Proof.
  intros. generalize dependent n. induction m; intros.
  - simpl. rewrite toList_Bin. rewrite IHm1. rewrite IHm2.
    rewrite fold_left_app. simpl. reflexivity.
  - reflexivity.
Qed.

(** ** Verification of [foldl'] *)

Lemma foldl'_spec:
  forall k (n : a) (m : Map e a),
  foldl' k n m = foldl k n m.
Proof. reflexivity. Qed.

(** ** Verification of [foldlWithKey'] *)
Lemma foldlWithKey'_spec:
  forall k (n : a) (m : Map e a),
  foldlWithKey' k n m = foldlWithKey k n m.
Proof. reflexivity. Qed.

(** ** Verification of [size] *)

Lemma size_spec:
  forall (s: Map e a) lb ub,
  Bounded s lb ub ->
  size s = Z.of_nat (length (toList s)).
Proof.
  intros. induction H.
  - simpl. reflexivity.
  - simpl. rewrite toList_Bin. simpl. rewrite app_length. simpl.
    rewrite Nat2Z.inj_add. rewrite <- IHBounded1.
    rewrite Nat2Z.inj_succ. rewrite <- IHBounded2.
    omega.
Qed.

(** ** Verification of [Eq] *)

(*Note: This is substantially different from SetProofs because the values' equality may differ between
Coq and Haskell. Instead of a single spec, we will prove 3 different specifications of [Eq]
1. [weak_equals_spec]: This states that m1 == m2 iff for every key, sem m1 key == sem m2 key
 (all according to Haskell notions of equality)
2. [strong_eq1]: If sem m1 key = sem m2 key for all keys, then m1 == m2 (the other direction is not true
in general)
3. [strong_eq2]: If Haskell equality is equivalent to Coq equality for the values (for example, if the
values are integers), then m1 == m2 iff for every key, sem m1 key = sem m2 key

The benefit of this is that the stronger notions of equality are much easier to work with in Coq proofs,
and means that if Coq and Haskell equality agree, we have a very strong specification of the equality of the
corresponding maps.
*)

(*START NEW*)
(*I'm still not quite sure how to organize this, as there is a ton of duplication, but this additional
specification gives a specification that is actually useful in Coq, allowing us to prove all the
properties we want even without an {eqLaws a} assumption*)
Fixpoint eqlist_key {e a} `{EqLaws e} (l1 l2 : list (e * a)) :=
  match l1, l2 with
  | nil, nil => True
  | x:: t1 , y :: t2 => let (a,b) := x in let (c,d) := y in (a == c = true /\ b = d /\ eqlist_key t1 t2)
  | _, _ => False
  end.

Lemma eqlist_key_sym:
  forall {e a} `{EqLaws e} (xs ys: list (e * a)),
  eqlist_key xs ys <-> eqlist_key ys xs.
Proof.
  intros. generalize dependent ys. induction xs; intros; destruct ys; try (reflexivity).
  simpl. destruct a1. destruct p. split; intros.
  - destruct H1. destruct H2. split. apply Eq_Symmetric. assumption. split. subst. reflexivity.
    rewrite <- IHxs. assumption.
  - destruct H1. destruct H2. split. apply Eq_Symmetric. assumption. split. subst. reflexivity.
    rewrite IHxs. assumption.
Qed.

Lemma eqlist_key_trans:
  forall {e a} `{EqLaws e} (xs ys zs: list (e * a)),
  eqlist_key xs ys ->
  eqlist_key ys zs ->
  eqlist_key xs zs.
Proof.
  intros. generalize dependent ys. revert zs. induction xs; intros; destruct ys; try (reflexivity);
  destruct (zs); try (reflexivity); try (inversion H1); try (inversion H2).
  simpl in H1. simpl in H2. destruct a1. destruct p. destruct p0. simpl.
  repeat match goal with
  | [H: _ /\ _  |- _] => destruct H
  end; subst. split. eapply Eq_Transitive. apply H1. apply H2. split. reflexivity.
  eapply IHxs. apply H6. apply H4.
Qed.

Lemma eqlist_key_refl:
  forall {e a} `{EqLaws e} (xs: list (e * a)),
  eqlist_key xs xs.
Proof.
  intros. induction xs. reflexivity. simpl.
  destruct a1. split. apply Eq_Reflexive. split. reflexivity. apply IHxs.
Qed.

Lemma eqlist_key_length:
  forall {e a} `{EqLaws e} (xs ys : list (e * a)),
  eqlist_key xs ys ->
  length xs = length ys.
Proof.
  intros. generalize dependent ys. induction xs; intros; destruct ys; try (reflexivity);
  try (inversion H1).
  simpl. simpl in H1. destruct a1. destruct p. destruct H1. destruct H2. erewrite IHxs.
  reflexivity. assumption.
Qed.

Lemma eqlist_Key_In:
  forall {e a}  `{EqLaws e} (xs ys : list (e * a)) x y,
  eqlist_key xs ys ->
  Key_In x y xs <-> Key_In x y ys.
Proof.
  intros. generalize dependent ys. induction xs; intros; destruct ys; simpl in *; try (reflexivity);
  try(destruct H1).
  destruct a1. destruct p. destruct H1. destruct H2. subst. split; intros.
  + destruct H2. destruct H2. left. split. eapply Eq_Transitive. apply Eq_Symmetric.
    apply H1. apply H2. assumption. right. apply IHxs. assumption. assumption.
  + destruct H2. destruct H2. left. split. eapply Eq_Transitive. apply H1. apply H2. assumption.
    right. rewrite  IHxs. apply H2. assumption.
Qed.

Lemma sem_false_nil:
  forall (m: Map e a),
  (forall i, sem m i = None) <-> m = Tip.
Proof.
  intros. destruct m.
  - simpl. split; intros.
    + specialize (H e0). rewrite Eq_Reflexive in H. simpl in H.
       destruct (sem m1 e0); inversion H.
    + inversion H.
  - simpl. split; intros; reflexivity.
Qed.

Lemma Forall_lt: forall (l : list (e * a)) t,
  Forall (lt t) l <-> (forall x y, Key_In x y l -> lt t (x,y)).
Proof.
  intros. split; induction l; intros.
  - inversion H0.
  - inversion H. inversion H0. subst. destruct a0. unfold lt. destruct t.
    unfold lt in H3. order e. apply IHl. apply H4. apply H5.
  - constructor.
  - simpl in H. destruct a0. constructor. specialize (H e0 a0). apply H.
    left. split. order e. reflexivity. apply IHl. intros. apply H.
    right. assumption.
Qed.

Lemma list_Key_In_eq : forall (x1 x2 : e) (y : a) l,
  x1 == x2 = true ->
  Key_In x1 y l <-> Key_In x2 y l.
Proof.
  intros. induction l; split; intros; try (inversion H0); simpl; destruct a0.
  - left. split. order e. destruct H1. assumption.
  - right. apply IHl. assumption.
  - left. split. order e. destruct H1. assumption.
  - right. apply IHl. assumption.
Qed.

Lemma strongly_sorted_unique:
  forall (xs ys : list (e * a)),
  StronglySorted lt xs ->
  StronglySorted lt ys ->
  (forall x y, Key_In x y xs <-> Key_In x y ys) ->
  eqlist_key xs ys.
Proof.
  intros. generalize dependent ys. induction xs; intros; destruct ys; try (reflexivity).
  - simpl in H1. destruct p. specialize (H1 e0 a0). destruct H1. apply H2. left.
    split. order e. reflexivity.
  - simpl in H1. destruct a0. specialize (H1 e0 a0). destruct H1. apply H1. left.
    split. order e. reflexivity.
  - simpl. destruct a0. destruct p. simpl in H1. inversion H; subst. inversion H0; subst.
    rewrite Forall_lt in H7. rewrite Forall_lt in H5. assert (A:=H1).
    specialize (H1 e1 a1). destruct H1.
    assert (_GHC.Base.==_ e0 e1 = true /\ a0 = a1 \/ Key_In e1 a1 xs). apply H2. left.
    split. order e. reflexivity. destruct H3. split. order e. split. destruct H3. subst.
    reflexivity. apply IHxs. assumption. assumption. intros.
    assert (A1:=A). specialize (A x y). split; intros.
    destruct A.
    assert (_GHC.Base.==_ e1 x = true /\ a1 = y \/ Key_In x y ys). apply H9. right.
    apply H8. destruct H11. apply H5 in H8. unfold lt in H8. order e. assumption.
    destruct A. assert (_GHC.Base.==_ e0 x = true /\ a0 = y \/ Key_In x y xs). apply H10.
    right. apply H8. destruct H11. apply H7 in H8. unfold lt in H8. order e. assumption.
    assert (A1:=A). specialize (A e0 a0). destruct A.
    assert ( _GHC.Base.==_ e1 e0 = true /\ a1 = a0 \/ Key_In e0 a0 ys). apply H8.
    left. split. order e. reflexivity. destruct H10.
    apply H5 in H3. unfold lt in H3. order e.
    apply H5 in H3. apply H7 in H10. unfold lt in H3. unfold lt in H10. order e.
Qed.

Lemma Key_In_unique: forall k (m: Map e a) lb ub v1 v2,
  Bounded m lb ub ->
  Key_In k v1 (toList m) /\ Key_In k v2 (toList m) -> v1 = v2.
Proof.
  intros. destruct H0. rewrite <- toList_sem in H0. rewrite <- toList_sem in H1.
  rewrite H1 in H0. inversion H0; subst; reflexivity. all: apply H.
Qed.

Lemma Key_In_not_in_list : forall key (map: Map e a) lb ub,
  Bounded map lb ub ->
  (forall value, (~Key_In key value (toList map))) <-> sem map key = None.
Proof.
  intros; split; intros.
  - destruct (sem map key) eqn : ?.
    + rewrite toList_sem in Heqo. specialize (H0 a0). contradiction. apply H.
    + reflexivity.
  - intro. rewrite <- toList_sem in H1. rewrite H1 in H0. inversion H0. apply H.
Qed.

Lemma eq_size : forall (m1: Map e a) m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  eqlist_key (toList m1) (toList m2)  ->
  Internal.size m1 = Internal.size m2.
Proof.
  intros. rewrite size_size. erewrite size_spec. erewrite size_spec.
  apply eqlist_key_length in H1. rewrite H1. reflexivity. all : eassumption.
Qed.

(*The real lemma we want for Coq purposes. This does not require any information about
{EqLaws a} and gives us a very useful specification of equivalent maps*)
Lemma coq_equals_spec: forall (m1: Map e a) m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  (forall i, sem m1 i = sem m2 i) <-> eqlist_key (toList m1) (toList m2).
Proof.
  intros. split; intros.
  - apply strongly_sorted_unique. eapply to_List_sorted. eassumption.
    eapply to_List_sorted. eassumption. intros. split; intros.
    + rewrite <- toList_sem in *. rewrite <- H1. assumption. all: eassumption.
    + rewrite <- toList_sem in *. rewrite H1. assumption. all: eassumption.
  - assert (forall x y, Key_In x y (toList m1) <-> Key_In x y (toList m2)). intros.
    apply eqlist_Key_In. assumption. specialize (H2 i).
    destruct (sem m1 i) eqn : ?. specialize (H2 a0). rewrite toList_sem in Heqo.
    apply H2 in Heqo. rewrite <- toList_sem in Heqo. symmetry. assumption.
    eassumption. eassumption. destruct (sem m2 i) eqn : ?.
    rewrite toList_sem in Heqo0. rewrite <- Key_In_not_in_list in Heqo.
    specialize (Heqo a0). specialize (H2 a0). apply H2 in Heqo0. contradiction.
    eassumption. eassumption. reflexivity.
Qed.

(*A useful corollary*)
Lemma size_sem: forall (m1: Map e a) m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  (forall i, sem m1 i = sem m2 i) ->
  size m1 = size m2.
Proof.
  intros. pose proof (coq_equals_spec m1 m2 lb ub H H0). destruct H2.
  apply H2 in H1. repeat(erewrite size_spec).
  assert (length (toList m1) = length (toList m2)). apply eqlist_key_length. assumption.
  rewrite H4. reflexivity. all: eassumption.
Qed.

(*END NEW*)

(*[eqlist] is symmetric*)
Lemma eqlist_sym:
  forall {a} `{EqLaws a} (xs ys : list a),
  eqlist xs ys = eqlist ys xs.
Proof.
  intros. generalize dependent ys. induction xs; intros.
  - destruct ys. reflexivity. simpl. reflexivity.
  - destruct ys. simpl. reflexivity. simpl.
    destruct (a1 == a2) eqn : ?.
    + simpl. rewrite Eq_Symmetric. simpl. apply IHxs. apply Heqb.
    + simpl. assert (a2 == a1 = false). apply Lemmas.Eq_neq_sym. assumption.
      rewrite H1. simpl. reflexivity.
Qed.

(*Equal lists have the same length*)
Lemma eqlist_length:
  forall {a} `{Eq_ a} (xs ys : list a),
  eqlist xs ys = true ->
  length xs = length ys.
Proof.
  intros. generalize dependent ys. induction xs; intros.
  - destruct ys. reflexivity. simpl in H0. discriminate H0.
  - destruct ys. simpl in H0. discriminate H0. simpl in H0.
    simpl. rewrite (IHxs ys). reflexivity. apply andb_true_iff in H0.
    destruct H0. assumption.
Qed.

(*Equal lists have the same elements in them*)
Lemma eqlist_elem:
  forall `{Eq_ a}  `{EqLaws a} (xs ys : list (e * a)) x y,
  eqlist xs ys = true ->
  List.elem (x, y) xs = true <-> List.elem (x, y) ys = true.
Proof.
  intros. generalize dependent ys. induction xs; intros.
  - simpl. destruct ys. simpl. reflexivity. simpl in H2. discriminate H2.
  - destruct ys. simpl in H2. discriminate H2. simpl. simpl in H2. split; intros.
    + destruct p. rewrite andb_true_iff in H2. destruct H2. rewrite orb_true_iff.
      rewrite orb_true_iff in H3. destruct H3. left. destruct a0.  eapply Eq_Tuple_Trans.
      apply H3. apply H2. right. apply IHxs. assumption. assumption.
    + rewrite orb_true_iff. rewrite orb_true_iff in H3. rewrite andb_true_iff in H2.
      destruct H2. destruct H3. left. destruct a0. destruct p. eapply Eq_Tuple_Trans.
      apply H3. eapply Eq_Tuple_Sym. assumption. right. rewrite (IHxs ys). assumption. assumption.
Qed.
(*
(*States that a map is empty iff sem key map returns None for every key*)
Lemma sem_false_nil:
  forall (m: Map e a),
  (forall i, sem m i = None) <-> m = Tip.
Proof.
  intros. remember m as m1. split; intros.
  - destruct m.
    + assert (sem m1 e0 <> None). { subst.
      simpl. destruct (sem m2 e0).
      * simpl. intro. discriminate H0.
      * simpl. rewrite Eq_Reflexive. simpl. intro. discriminate H0. }
        specialize (H e0). rewrite H in H0. contradiction.
    + assumption.
  - rewrite H. simpl. reflexivity.
Qed.
*)
(*We don't want to use Forall_forall because all we know is that List.elem is true,
which is much weaker than List.In*)
Lemma Forall_lt': forall `{Eq_ a} `{EqLaws a} (l : list (e * a)) t,
  Forall (lt t) l <-> (forall x y, List.elem (x, y) l = true -> lt t (x,y)).
Proof.
  intros. split; induction l; intros.
  - simpl in H3. discriminate H3.
  - inversion H2. subst. simpl in H3. rewrite orb_true_iff in H3. destruct H3.
    destruct t. destruct a0. unfold lt in H6. unfold lt. rewrite eq_tuple_prop in H3.
    order e. apply IHl. apply H7. apply H3.
  - apply Forall_nil.
  - apply Forall_cons. destruct a0. specialize (H2 e0 a0). apply H2. simpl.
    apply orb_true_iff. left. apply Eq_Tuple_Refl. apply IHl. intros. apply H2.
    simpl. apply orb_true_iff. right. apply H3.
Qed.

(*If two tuples are equal according to Haskell, List.elem returns the same result for either on a list*)
Lemma list_elem_eq : forall `{Eq_ a} `{EqLaws a} (x1 x2 : e) (y1 y2 : a) l,
  (x1, y1) == (x2, y2) = true ->
  List.elem (x1, y1) l = true <-> List.elem (x2, y2) l = true.
Proof.
  intros. induction l.
  - simpl. split; intros; discriminate H3.
  - split; intros; simpl in *; rewrite orb_true_iff in *.
    + destruct H3.
      * left. destruct a0. eapply Eq_Tuple_Trans. eapply Eq_Tuple_Sym. apply H2. apply H3.
      * right. apply IHl. apply H3.
    + destruct H3.
      * left. destruct a0. eapply Eq_Tuple_Trans. apply H2. apply H3.
      * right. apply IHl. apply H3.
Qed.

(*Strongly sorted lists with the same elements are the same.*)
(*TODO: Clean up the proof*)
Lemma strongly_sorted_unique':
  forall `{Eq_ a} `{EqLaws a} (xs ys : list (e * a)),
  StronglySorted lt xs ->
  StronglySorted lt ys ->
  (forall x y, List.elem (x, y) xs = true <-> List.elem (x,y) ys = true) ->
  eqlist xs ys = true.
Proof.
  intros. generalize dependent ys. induction xs; intros.
  - simpl in H4. destruct ys. reflexivity.
    assert (forall x y, List.elem (x,y) (p :: ys) = false). { intros. specialize (H4 x y).
   destruct H4. apply contrapositive in H5. destruct (List.elem (x, y) (p :: ys)). contradiction.
    reflexivity. intro. discriminate H6. }
    assert (List.elem p (p :: ys) = true). { simpl. rewrite orb_true_iff. left. destruct p.
    apply Eq_Tuple_Refl. } destruct p. specialize (H5 e0 a0). rewrite H6 in H5. discriminate H5.
  - destruct ys.
    + assert (forall x y, List.elem (x,y) (a0 :: xs) = false). { intros x y.
      specialize (H4 x y). destruct H4. apply contrapositive in H4. destruct (List.elem (x, y) (a0 :: xs)).
      contradiction. reflexivity. intro. simpl in H6. discriminate H6. }
      destruct a0. assert (List.elem (e0, a0) ((e0, a0) :: xs) = true). { simpl. rewrite orb_true_iff.
      left. apply Eq_Tuple_Refl. }
      specialize (H5 e0 a0). rewrite H6 in H5. discriminate H5.
    + simpl. rewrite andb_true_iff. inversion H2; subst. inversion H3; subst. split.
      assert (A:=H4). destruct a0. destruct p. specialize (H4 e0 a0). specialize (A e1 a1).
      destruct H4. destruct A.
      assert (List.elem (e0, a0) ((e1, a1) :: ys) = true). { apply H4. simpl. rewrite orb_true_iff.
      left. apply Eq_Tuple_Refl. }
      assert (List.elem (e1, a1) ((e0, a0) :: xs) = true). { apply H11. simpl. rewrite orb_true_iff.
      left. apply Eq_Tuple_Refl. }
      rewrite Forall_lt' in H8. rewrite Forall_lt' in H10. simpl in H12. simpl in H13.
      rewrite orb_true_iff in *. destruct H12. destruct H13. apply H12. apply H12.
      destruct H13. apply Eq_Tuple_Sym. apply H13. apply H8 in H13. apply H10 in H12.
      unfold lt in H12. unfold lt in H13. order e.
      apply IHxs. assumption. assumption. intros. split; intros.
      * assert (A1:=H4). specialize (H4 x y). destruct H4. rewrite Forall_lt' in H8. rewrite Forall_lt' in H10.
        assert (A:=H5).  assert (List.elem (x,y) (a0 :: xs) = true). {
        simpl. rewrite orb_true_iff. right. assumption. }
        apply H4 in H11. simpl in H11.  rewrite orb_true_iff in H11. destruct H11.
        { apply H8 in H5. destruct p. assert (List.elem (e0, a1) (a0 :: xs) = true). {
          apply A1. simpl. rewrite orb_true_iff. left. apply Eq_Tuple_Refl. }
          simpl in H12. rewrite orb_true_iff in H12. destruct H12.
          { destruct a0. unfold lt in H5. rewrite eq_tuple_prop in H11. rewrite eq_tuple_prop in H12.
            order e. }
          { destruct a0. assert (List.elem (e1, a0) ((e0, a1) :: ys) = true). { apply A1.
            simpl. rewrite orb_true_iff. left. apply Eq_Tuple_Refl. }
           simpl in H13. rewrite orb_true_iff in H13. destruct H13.
            { rewrite eq_tuple_prop in H11. rewrite eq_tuple_prop in H13.
              apply H8 in A. apply H8 in H12. unfold lt in *. order e. }
            { assert (A2:=H13). assert (A3:=H12). apply H10 in H13. apply H8 in H12.
              unfold lt in *. order e. }
            }
          }
          { apply H11. }
          (*Basically the same proof - try to clean up*)
        * assert (A1:=H4). specialize (H4 x y). destruct H4. rewrite Forall_lt' in H8. rewrite Forall_lt' in H10.
        assert (A:=H5).  assert (List.elem (x,y) (p :: ys) = true). {
        simpl. rewrite orb_true_iff. right. assumption. }
        apply H6 in H11. simpl in H11.  rewrite orb_true_iff in H11. destruct H11.
        { apply H10 in H5. destruct p. assert (List.elem (e0, a1) (a0 :: xs) = true). {
          apply A1. simpl. rewrite orb_true_iff. left. apply Eq_Tuple_Refl. }
          simpl in H12. rewrite orb_true_iff in H12. destruct H12.
          { destruct a0. unfold lt in H5. rewrite eq_tuple_prop in H11. rewrite eq_tuple_prop in H12.
            order e. }
          { destruct a0. assert (List.elem (e1, a0) ((e0, a1) :: ys) = true). { apply A1.
            simpl. rewrite orb_true_iff. left. apply Eq_Tuple_Refl. }
           simpl in H13. rewrite orb_true_iff in H13. destruct H13.
            { rewrite eq_tuple_prop in H11. rewrite eq_tuple_prop in H13.
              apply H10 in A. apply H8 in H12. unfold lt in *. order e. }
            { assert (A2:=H13). assert (A3:=H12). apply H10 in H13. apply H8 in H12.
              unfold lt in *. order e. }
            }
          }
          { apply H11. }
Qed.

(*A few final lemmas before the [Eq] specs. The first states that if a key is not in [toList],
  then sem returns false, and vice versa. *)

Lemma elem_not_in_list : forall `{Eq_ a} `{EqLaws a} key map lb ub,
  Bounded map lb ub ->
  (forall value, List.elem (key, value) (toList map) = false) <-> sem map key = None.
Proof.
  intros; split; intros.
  - destruct (sem map key) eqn : ?.
    + assert (sem map key == Some a0 = true). { rewrite Heqo. apply Eq_Reflexive. } eapply toList_sem' in H4.
      specialize (H3 a0). rewrite H4 in H3. discriminate H3. apply H2.
    + reflexivity.
  - destruct (List.elem (key, value) (toList map)) eqn : ?.
    + rewrite <- toList_sem' in Heqb. rewrite H3 in Heqb. discriminate Heqb. apply H2.
    + reflexivity.
Qed.

(*If two maps have equal lists, their size is equal*)
Lemma eq_size' : forall `{Eq_ a} `{EqLaws a} m1 m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  toList m1 == toList m2 = true ->
  Internal.size m1 = Internal.size m2.
Proof.
  intros. rewrite size_size. erewrite size_spec. erewrite size_spec.
  unfold op_zeze__ in H4. unfold Eq_list in H4. unfold op_zeze____ in H4. apply eqlist_length in H4.
  rewrite H4. reflexivity. apply H3. apply H2.
Qed.

(*Map equality is defined by checking both [length] and [toList], but [length] does not matter.
This makes the next proofs a bit easier.*)
Lemma eq_toList : forall `{Eq_ a} `{EqLaws a} m1 m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  m1 == m2 = true <-> (toList m1 == toList m2) = true.
Proof.
  intros. split; intros.
  - unfold op_zeze__ in H4. unfold Eq___Map in H4. unfold op_zeze____ in H4.
    unfold Internal.Eq___Map_op_zeze__ in H4. rewrite andb_true_iff in H4. destruct H4.
    unfold toList. assumption.
  - unfold_zeze. unfold  Eq___Map. unfold Internal.Eq___Map_op_zeze__. rewrite andb_true_iff.
    split. assert (Internal.size m1 = Internal.size m2). eapply eq_size'. apply H2. apply H3.
    assumption. rewrite H5. apply Eq_Reflexive. unfold toList in *. assumption.
Qed.

Lemma weak_equals_spec:
  forall `{Eq_ a} `{EqLaws a} m1 m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  m1 == m2 = true <-> (forall i, sem m1 i == sem m2 i = true).
Proof.
  intros. split; intros. unfold op_zeze__ in H4. unfold Eq___Map in H4.
      unfold op_zeze____ in H4. unfold Internal.Eq___Map_op_zeze__ in H4.  rewrite andb_true_iff in H4.
      destruct H4. unfold op_zeze__ in H5. unfold Eq_list in H5. unfold op_zeze____ in H5.
  - destruct (sem m1 i) eqn : ?.
    + eapply eqlist_elem in H5. assert (sem m1 i == Some a0 = true). { rewrite Heqo. apply Eq_Reflexive. }
      rewrite toList_sem' in H6. unfold toList in H6. apply H5 in H6. rewrite <- toList_sem' in H6.
      apply Eq_Symmetric. apply H6. apply H3. apply H2.
    + rewrite <- elem_not_in_list in Heqo. pose proof (toList_sem') as H7. specialize (H7 m2 lb ub H3 i).
      assert (forall value, List.elem (i, value) (toList m2) = false). { intros.
      specialize (H7 value). destruct H7. apply contrapositive in H7.
      destruct (List.elem (i, value) (toList m2)). contradiction. reflexivity.
      assert (forall value, List.elem (i, value) (toAscList m2) = false). { intros.
      apply (eqlist_elem _ _ i value0) in H5. destruct H5. apply contrapositive in H8.
      destruct (List.elem (i, value0) (toAscList m2)). contradiction. reflexivity.
      destruct (List.elem (i, value0) (toAscList m1)) eqn : ?. specialize (Heqo value0).
      unfold toList in Heqo. rewrite Heqo in Heqb. discriminate Heqb. intro. discriminate H9. }
      eapply elem_not_in_list in H8. rewrite H8. intro. discriminate H9. apply H3. }
      eapply elem_not_in_list in H6. rewrite H6. order e. apply H3. apply H2.
  - eapply eq_toList. apply H2. apply H3. apply strongly_sorted_unique'. eapply to_List_sorted.
    apply H2. eapply to_List_sorted. apply H3. intros. split; intros.
    + rewrite <- toList_sem' in H5. specialize (H4 x). assert (sem m2 x == Some y = true).
      { eapply Eq_Transitive. apply Eq_Symmetric. apply H4. apply H5. }
      rewrite toList_sem' in H6. assumption. apply H3. apply H2.
    + rewrite <-toList_sem' in H5. specialize (H4 x). assert (sem m1 x == Some y = true).
      { eapply Eq_Transitive. apply H4. apply H5. } rewrite toList_sem' in H6. assumption.
      apply H2. apply H3.
Qed.

Lemma strong_eq1 : forall `{Eq_ a} `{EqLaws a} m1 m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  (forall i, sem m1 i = sem m2 i) -> m1 == m2 = true.
Proof. intros.
  assert (forall i, (sem m1 i == sem m2 i = true)). { intros. specialize (H4 i).
  rewrite H4. apply Eq_Reflexive. } eapply weak_equals_spec in H5. assumption.
  apply H2. apply H3.
Qed.

Lemma strong_eq2 : forall `{Eq_ a} `{EqLaws a} m1 m2 lb ub,
  Bounded m1 lb ub ->
  Bounded m2 lb ub ->
  (forall (y1 : a) (y2 : a), y1 == y2 = true <-> y1 = y2) ->
  (forall i, sem m1 i =  sem m2 i) <-> m1 == m2 = true.
Proof.
  intros. split; intros.
  - eapply strong_eq1. apply H2. apply H3. apply H5.
  - rewrite weak_equals_spec in H5. specialize (H5 i).
    destruct (sem m1 i). destruct (sem m2 i).
    rewrite simpl_option_some_eq in H5. rewrite H4 in H5. subst. reflexivity.
    discriminate H5. destruct (sem m2 i). discriminate H5. reflexivity. apply H2. apply H3.
Qed.

End WF.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)
(*i   	  $Id$      i*)

Require Import Bool.
Require Import Sumbool.
Require Import NArith.
Require Import Ndigits.
Require Import Ndec.
Require Import Map.
Require Import Fset.
Require Import Mapaxioms.
Require Import Mapiter.
Require Import Lsort.
Require Import Mapsubset.
Require Import List.

Section MapFoldResults.

  Variable A : Type.

  Variable M : Type.
  Variable neutral : M.
  Variable op : M -> M -> M.

  Variable nleft : forall a:M, op neutral a = a.
  Variable nright : forall a:M, op a neutral = a.
  Variable assoc : forall a b c:M, op (op a b) c = op a (op b c).

  Lemma MapFold_ext :
   forall (f:ad -> A -> M) (m m':Map A),
     eqmap A m m' -> MapFold _ _ neutral op f m = MapFold _ _ neutral op f m'.
  Proof.
    intros. rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m).
    rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m').
    cut (alist_of_Map A m = alist_of_Map A m'). intro. rewrite H0. reflexivity.
    apply alist_canonical. unfold eqmap in H. apply eqm_trans with (f' := MapGet A m).
    apply eqm_sym. apply alist_of_Map_semantics.
    apply eqm_trans with (f' := MapGet A m'). assumption.
    apply alist_of_Map_semantics.
    apply alist_of_Map_sorts2.
    apply alist_of_Map_sorts2.
  Qed.

  Lemma MapFold_ext_f_1 :
   forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad),
     (forall (a:ad) (y:A), MapGet _ m a = Some y -> f (pf a) y = g (pf a) y) ->
     MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m.
  Proof.
    simple induction m. trivial.
    simpl in |- *. intros. apply H. rewrite (Neqb_correct a). reflexivity.
    intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (Ndouble a0))).
    rewrite (H0 f g (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity.
    intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption.
    apply Ndouble_plus_one_bit0.
    intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption.
    apply Ndouble_bit0.
  Qed.

  Lemma MapFold_ext_f :
   forall (f g:ad -> A -> M) (m:Map A),
     (forall (a:ad) (y:A), MapGet _ m a = Some y -> f a y = g a y) ->
     MapFold _ _ neutral op f m = MapFold _ _ neutral op g m.
  Proof.
    intros. exact (MapFold_ext_f_1 m f g (fun a0:ad => a0) H).
  Qed.

  Lemma MapFold1_as_Fold_1 :
   forall (m:Map A) (f f':ad -> A -> M) (pf pf':ad -> ad),
     (forall (a:ad) (y:A), f (pf a) y = f' (pf' a) y) ->
     MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f' pf' m.
  Proof.
    simple induction m. trivial.
    intros. simpl in |- *. apply H.
    intros. simpl in |- *.
    rewrite
     (H f f' (fun a0:ad => pf (Ndouble a0))
        (fun a0:ad => pf' (Ndouble a0))).
    rewrite
     (H0 f f' (fun a0:ad => pf (Ndouble_plus_one a0))
        (fun a0:ad => pf' (Ndouble_plus_one a0))).
    reflexivity.
    intros. apply H1.
    intros. apply H1.
  Qed.

  Lemma MapFold1_as_Fold :
   forall (f:ad -> A -> M) (pf:ad -> ad) (m:Map A),
     MapFold1 _ _ neutral op f pf m =
     MapFold _ _ neutral op (fun (a:ad) (y:A) => f (pf a) y) m.
  Proof.
    intros. unfold MapFold in |- *. apply MapFold1_as_Fold_1. trivial.
  Qed.

  Lemma MapFold1_ext :
   forall (f:ad -> A -> M) (m m':Map A),
     eqmap A m m' ->
     forall pf:ad -> ad,
       MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f pf m'.
  Proof.
    intros. rewrite MapFold1_as_Fold. rewrite MapFold1_as_Fold. apply MapFold_ext. assumption.
  Qed.

  Variable comm : forall a b:M, op a b = op b a.

  Lemma MapFold_Put_disjoint_1 :
   forall (p:positive) (f:ad -> A -> M) (pf:ad -> ad)
     (a1 a2:ad) (y1 y2:A),
     Nxor a1 a2 = Npos p ->
     MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p) =
     op (f (pf a1) y1) (f (pf a2) y2).
  Proof.
    simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1.
    simpl in |- *. rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double. apply comm.
    change (Nbit0 a2 = negb true) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0).
    rewrite negb_elim. reflexivity.
    assumption.
    intro H1. rewrite H1. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one.
    reflexivity.
    change (Nbit0 a2 = negb false) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0).
    rewrite negb_elim. reflexivity.
    assumption.
    simpl in |- *. intros. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1. simpl in |- *.
    rewrite nleft.
    rewrite
     (H f (fun a0:ad => pf (Ndouble_plus_one a0)) (
        Ndiv2 a1) (Ndiv2 a2) y1 y2).
    rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double_plus_one. reflexivity.
    unfold Nodd.
    rewrite <- (Nsame_bit0 _ _ _ H0). assumption.
    assumption.
    rewrite <- Nxor_div2. rewrite H0. reflexivity.
    intro H1. rewrite H1. simpl in |- *. rewrite nright.
    rewrite
     (H f (fun a0:ad => pf (Ndouble a0)) (Ndiv2 a1) (Ndiv2 a2) y1 y2)
     .
    rewrite Ndiv2_double. rewrite Ndiv2_double. reflexivity.
    unfold Neven.
    rewrite <- (Nsame_bit0 _ _ _ H0). assumption.
    assumption.
    rewrite <- Nxor_div2. rewrite H0. reflexivity.
    intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H0. rewrite H0. simpl in |- *.
    rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. apply comm.
    assumption.
    change (Nbit0 a2 = negb true) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H).
    rewrite negb_elim. reflexivity.
    intro H0. rewrite H0. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one.
    reflexivity.
    change (Nbit0 a2 = negb false) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H).
    rewrite negb_elim. reflexivity.
    assumption.
  Qed.

  Lemma MapFold_Put_disjoint_2 :
   forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad),
     MapGet A m a = None ->
     MapFold1 A M neutral op f pf (MapPut A m a y) =
     op (f (pf a) y) (MapFold1 A M neutral op f pf m).
  Proof.
    simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity.
    intros a1 y1 a2 y2 pf H. simpl in |- *. elim (Ndiscr (Nxor a1 a2)). intro H0. elim H0.
    intros p H1. rewrite H1. rewrite comm. exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1).
    intro H0. rewrite (Neqb_complete _ _ (Nxor_eq_true _ _ H0)) in H.
    rewrite (M1_semantics_1 A a2 y1) in H. discriminate H.
    intros. elim (sumbool_of_bool (Nbit0 a)). intro H2.
    cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (Ndiv2 a) y)). intro.
    rewrite H3. simpl in |- *. rewrite (H0 (Ndiv2 a) y (fun a0:ad => pf (Ndouble_plus_one a0))).
    rewrite Ndiv2_double_plus_one. rewrite <- assoc.
    rewrite
     (comm (MapFold1 A M neutral op f (fun a0:ad => pf (Ndouble a0)) m0)
        (f (pf a) y)).
    rewrite assoc. reflexivity.
    assumption.
    rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. assumption.
    simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5.
    reflexivity.
    intros p0 H4 H5. rewrite H5 in H2. discriminate H2.
    intro H4. rewrite H4. reflexivity.
    intro H3. rewrite H3 in H2. discriminate H2.
    intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (Ndiv2 a) y) m1).
    intro. rewrite H3. simpl in |- *. rewrite (H (Ndiv2 a) y (fun a0:ad => pf (Ndouble a0))).
    rewrite Ndiv2_double. rewrite <- assoc. reflexivity.
    assumption.
    rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. assumption.
    simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2.
    discriminate H2.
    intros p0 H4 H5. rewrite H5. reflexivity.
    intro H4. rewrite H4 in H2. discriminate H2.
    intro H3. rewrite H3. reflexivity.
  Qed.

  Lemma MapFold_Put_disjoint :
   forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A),
     MapGet A m a = None ->
     MapFold A M neutral op f (MapPut A m a y) =
     op (f a y) (MapFold A M neutral op f m).
  Proof.
    intros. exact (MapFold_Put_disjoint_2 f m a y (fun a0:ad => a0) H).
  Qed.

  Lemma MapFold_Put_behind_disjoint_2 :
   forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad),
     MapGet A m a = None ->
     MapFold1 A M neutral op f pf (MapPut_behind A m a y) =
     op (f (pf a) y) (MapFold1 A M neutral op f pf m).
  Proof.
    intros. cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). intro.
    rewrite (MapFold1_ext f _ _ H0 pf). apply MapFold_Put_disjoint_2. assumption.
    apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge.
    apply eqmap_trans with (m' := MapMerge A m (M1 A a y)).
    apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint.
    unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a0)).
    intro H2. rewrite (Neqb_complete _ _ H2) in H. rewrite H in H1. discriminate H1.
    intro H2. rewrite H2 in H0. discriminate H0.
    apply eqmap_trans with (m' := MapDelta A m (M1 A a y)). apply MapDelta_sym.
    apply MapDelta_disjoint. unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros.
    elim (sumbool_of_bool (Neqb a a0)). intro H2. rewrite (Neqb_complete _ _ H2) in H.
    rewrite H in H0. discriminate H0.
    intro H2. rewrite H2 in H1. discriminate H1.
    apply eqmap_sym. apply MapPut_as_Merge.
  Qed.

  Lemma MapFold_Put_behind_disjoint :
   forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A),
     MapGet A m a = None ->
     MapFold A M neutral op f (MapPut_behind A m a y) =
     op (f a y) (MapFold A M neutral op f m).
  Proof.
    intros. exact (MapFold_Put_behind_disjoint_2 f m a y (fun a0:ad => a0) H).
  Qed.

  Lemma MapFold_Merge_disjoint_1 :
   forall (f:ad -> A -> M) (m1 m2:Map A) (pf:ad -> ad),
     MapDisjoint A A m1 m2 ->
     MapFold1 A M neutral op f pf (MapMerge A m1 m2) =
     op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2).
  Proof.
    simple induction m1. simpl in |- *. intros. rewrite nleft. reflexivity.
    intros. unfold MapMerge in |- *. apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf).
    apply in_dom_none. exact (MapDisjoint_M1_l _ _ m2 a a0 H).
    simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity.
    intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm.
    apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1).
    intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (Ndouble a0))).
    rewrite (H0 m4 (fun a0:ad => pf (Ndouble_plus_one a0))).
    cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4.
    intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d).
    rewrite assoc. reflexivity.
    exact (MapDisjoint_M2_r _ _ _ _ _ _ H3).
    exact (MapDisjoint_M2_l _ _ _ _ _ _ H3).
  Qed.

  Lemma MapFold_Merge_disjoint :
   forall (f:ad -> A -> M) (m1 m2:Map A),
     MapDisjoint A A m1 m2 ->
     MapFold A M neutral op f (MapMerge A m1 m2) =
     op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2).
  Proof.
    intros. exact (MapFold_Merge_disjoint_1 f m1 m2 (fun a0:ad => a0) H).
  Qed.

End MapFoldResults.

Section MapFoldDistr.

  Variable A : Type.

  Variable M : Type.
  Variable neutral : M.
  Variable op : M -> M -> M.

  Variable M' : Type.
  Variable neutral' : M'.
  Variable op' : M' -> M' -> M'.

  Variable N : Type.

  Variable times : M -> N -> M'.

  Variable absorb : forall c:N, times neutral c = neutral'.
  Variable
    distr :
      forall (a b:M) (c:N), times (op a b) c = op' (times a c) (times b c).

  Lemma MapFold_distr_r_1 :
   forall (f:ad -> A -> M) (m:Map A) (c:N) (pf:ad -> ad),
     times (MapFold1 A M neutral op f pf m) c =
     MapFold1 A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) pf m.
  Proof.
    simple induction m. intros. exact (absorb c).
    trivial.
    intros. simpl in |- *. rewrite distr. rewrite H. rewrite H0. reflexivity.
  Qed.

  Lemma MapFold_distr_r :
   forall (f:ad -> A -> M) (m:Map A) (c:N),
     times (MapFold A M neutral op f m) c =
     MapFold A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) m.
  Proof.
    intros. exact (MapFold_distr_r_1 f m c (fun a:ad => a)).
  Qed.

End MapFoldDistr.

Section MapFoldDistrL.

  Variable A : Type.

  Variable M : Type.
  Variable neutral : M.
  Variable op : M -> M -> M.

  Variable M' : Type.
  Variable neutral' : M'.
  Variable op' : M' -> M' -> M'.

  Variable N : Type.

  Variable times : N -> M -> M'.

  Variable absorb : forall c:N, times c neutral = neutral'.
  Variable
    distr :
      forall (a b:M) (c:N), times c (op a b) = op' (times c a) (times c b).

  Lemma MapFold_distr_l :
   forall (f:ad -> A -> M) (m:Map A) (c:N),
     times c (MapFold A M neutral op f m) =
     MapFold A M' neutral' op' (fun (a:ad) (y:A) => times c (f a y)) m.
  Proof.
    intros. apply MapFold_distr_r with (times := fun (a:M) (b:N) => times b a);
  assumption.
  Qed.

End MapFoldDistrL.

Section MapFoldExists.

  Variable A : Type.

  Lemma MapFold_orb_1 :
   forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad),
     MapFold1 A bool false orb f pf m =
     match MapSweep1 A f pf m with
     | Some _ => true
     | _ => false
     end.
  Proof.
    simple induction m. trivial.
    intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity.
    intros. simpl in |- *. rewrite (H (fun a0:ad => pf (Ndouble a0))).
    rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))).
    case (MapSweep1 A f (fun a0:ad => pf (Ndouble a0)) m0); reflexivity.
  Qed.

  Lemma MapFold_orb :
   forall (f:ad -> A -> bool) (m:Map A),
     MapFold A bool false orb f m =
     match MapSweep A f m with
     | Some _ => true
     | _ => false
     end.
  Proof.
    intros. exact (MapFold_orb_1 f m (fun a:ad => a)).
  Qed.

End MapFoldExists.

Section DMergeDef.

  Variable A : Type.

  Definition DMerge :=
    MapFold (Map A) (Map A) (M0 A) (MapMerge A) (fun (_:ad) (m:Map A) => m).

  Lemma in_dom_DMerge_1 :
   forall (m:Map (Map A)) (a:ad),
     in_dom A a (DMerge m) =
     match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with
     | Some _ => true
     | _ => false
     end.
  Proof.
    unfold DMerge in |- *. intros.
    rewrite
     (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false orb ad
        (in_dom A) (fun c:ad => refl_equal _) (in_dom_merge A))
     .
    apply MapFold_orb.
  Qed.

  Lemma in_dom_DMerge_2 :
   forall (m:Map (Map A)) (a:ad),
     in_dom A a (DMerge m) = true ->
     {b : ad &
     {m0 : Map A | MapGet _ m b = Some m0 /\ in_dom A a m0 = true}}.
  Proof.
    intros m a. rewrite in_dom_DMerge_1.
    elim
     (option_sum _
        (MapSweep (Map A) (fun (_:ad) (m0:Map A) => in_dom A a m0) m)).
    intro H. elim H. intro r. elim r. intros b m0 H0. intro. split with b. split with m0.
    split. exact (MapSweep_semantics_2 _ _ _ _ _ H0).
    exact (MapSweep_semantics_1 _ _ _ _ _ H0).
    intro H. rewrite H. intro. discriminate H0.
  Qed.

  Lemma in_dom_DMerge_3 :
   forall (m:Map (Map A)) (a b:ad) (m0:Map A),
     MapGet _ m a = Some m0 ->
     in_dom A b m0 = true -> in_dom A b (DMerge m) = true.
  Proof.
    intros m a b m0 H H0. rewrite in_dom_DMerge_1.
    elim
     (MapSweep_semantics_4 _ (fun (_:ad) (m'0:Map A) => in_dom A b m'0) _ _ _
        H H0).
    intros a' H1. elim H1. intros m'0 H2. rewrite H2. reflexivity.
  Qed.

End DMergeDef.


Require Import List.
Export ListNotations.

Require Import genT.
Require Import gen_tacs.
Require Import List_lemmasT.
Require Import existsT.
Require Import GL4ip_PSGL4ip_calcs.

(* Some useful lemmas about lists. *)

Lemma in_exch_list : forall {A : Type} (l0 l1 l2 l3 l4 : list A) (a : A),
  In a (l0 ++ l1 ++ l2 ++ l3 ++ l4) -> In a (l0 ++ l3 ++ l2 ++ l1 ++ l4).
Proof.
intros A l0 l1 l2 l3 l4 a H.
apply in_app_or in H. destruct H. apply in_or_app. left. assumption.
apply in_app_or in H. destruct H. apply in_or_app. right. apply in_or_app. right.
apply in_or_app. right. apply in_or_app. left. assumption.
apply in_app_or in H. destruct H. apply in_or_app. right. apply in_or_app. right.
apply in_or_app. left. assumption.
apply in_app_or in H. destruct H. apply in_or_app. right. apply in_or_app. left.
assumption.
apply in_or_app. right. apply in_or_app. right. apply in_or_app. right.
apply in_or_app. right. assumption.
Qed.

Lemma InT_exch_list : forall {A : Type} (l0 l1 l2 l3 l4 : list A) (a : A),
  InT a (l0 ++ l1 ++ l2 ++ l3 ++ l4) -> InT a (l0 ++ l3 ++ l2 ++ l1 ++ l4).
Proof.
intros A l0 l1 l2 l3 l4 a H.
apply InT_app_or in H. destruct H. apply InT_or_app. left. assumption.
apply InT_app_or in i. destruct i. apply InT_or_app. right. apply InT_or_app. right.
apply InT_or_app. right. apply InT_or_app. left. assumption.
apply InT_app_or in i. destruct i. apply InT_or_app. right. apply InT_or_app. right.
apply InT_or_app. left. assumption.
apply InT_app_or in i. destruct i. apply InT_or_app. right. apply InT_or_app. left.
assumption.
apply InT_or_app. right. apply InT_or_app. right. apply InT_or_app. right.
apply InT_or_app. right. assumption.
Qed.

Lemma partition_1_element : forall {A : Type} (l1 l2 l3 l4 l5 l6 l7 : list A) a,
l1 ++ l2 ++ l3 ++ l4 ++ l5 = l6 ++ a :: l7 ->
  (existsT2 l8 l9, l1 = l8 ++ a :: l9) +
  ((existsT2 l8 l9, l2 = l8 ++ a :: l9) +
  ((existsT2 l8 l9, l3 = l8 ++ a :: l9) +
  ((existsT2 l8 l9, l4 = l8 ++ a :: l9) +
  ((existsT2 l8 l9, l5 = l8 ++ a :: l9))))).
Proof.
intros A l1. induction l1.
- simpl. induction l2.
  * simpl. induction l3.
    + simpl. induction l4.
      { simpl. intros. right. right. right. right. exists l6. exists l7.
        assumption. }
      { intros. destruct l6. simpl in H. right. right. right. left. exists []. simpl.
        inversion H. exists l4. reflexivity.
        inversion H. apply IHl4 in H2. destruct H2. destruct s. destruct s. exfalso.
        apply app_cons_not_nil in e. assumption.
        destruct s. destruct s. destruct s. exfalso.
        apply app_cons_not_nil in e. assumption.
        destruct s. destruct s. destruct s. exfalso.
        apply app_cons_not_nil in e. assumption.
        destruct s. destruct s. destruct s. right. right. right.
        left. exists (a1 :: x). exists x0. simpl. rewrite e. reflexivity.
        destruct s. destruct s. right. right. right. right. exists x. exists x0.
        assumption. }
    + intros l4 l5 l6 l7 a0 E. destruct l6.
      { inversion E. right. right. left. exists []. exists l3. simpl. reflexivity. }
      { inversion E. apply IHl3 in H1. destruct H1.
        destruct s. destruct s. exfalso.
        apply app_cons_not_nil in e. assumption.
        destruct s. destruct s. destruct s. exfalso.
        apply app_cons_not_nil in e. assumption.
        destruct s. destruct s. destruct s. right. right. left. exists (a1 :: x).
        exists x0. rewrite e. simpl. reflexivity.
        right. right. right. assumption. }
  * intros l3 l4 l5 l6 l7 a0 E. destruct l6. inversion E.
    { inversion E. right. left. exists []. exists l2. simpl. reflexivity. }
    { inversion E. apply IHl2 in H1. destruct H1.
      destruct s. destruct s. exfalso.
      apply app_cons_not_nil in e. assumption.
      destruct s. destruct s. destruct s. right. left. exists (a1 :: x). exists x0.
      rewrite e. simpl. reflexivity.
      right. right. assumption. }
- intros l2 l3 l4 l5 l6 l7 a0 E. destruct l6.
  { inversion E. left. exists []. exists l1. auto. }
  { inversion E. apply IHl1 in H1. destruct H1.
    destruct s. destruct s. left. exists (a1 :: x). exists x0. rewrite e. auto.
    right. assumption. }
Qed.

Lemma partition_1_element2 : forall {A : Type} (l1 l2 l3 l4 l5 l6 l7 : list A) a,
l1 ++ l2 ++ l3 ++ l4 ++ l5 = l6 ++ a :: l7 ->
  ((existsT2 l8 l9, (l1 = l8 ++ a :: l9) * (l9 ++ l2 ++ l3 ++ l4 ++ l5 = l7) * (l8 = l6)) +
  ((existsT2 l8 l9, (l2 = l8 ++ a :: l9) * (l9 ++ l3 ++ l4 ++ l5 = l7) * (l1 ++ l8 = l6)) +
  ((existsT2 l8 l9, (l3 = l8 ++ a :: l9) * (l9 ++ l4 ++ l5 = l7) * (l1 ++ l2 ++ l8 = l6)) +
  ((existsT2 l8 l9, (l4 = l8 ++ a :: l9) * (l9 ++ l5 = l7) * (l1 ++ l2 ++ l3 ++ l8 = l6)) +
  ((existsT2 l8 l9, (l5 = l8 ++ a :: l9) * (l9 = l7) * (l1 ++ l2 ++ l3 ++ l4 ++ l8 = l6))))))).
Proof.
intros A l1. induction l1.
- simpl. induction l2.
  * simpl. induction l3.
    + simpl. induction l4.
      { simpl. intros. right. right. right. right. exists l6. exists l7.
        split. split. assumption. reflexivity. reflexivity. }
      { intros. destruct l6. simpl in H. right. right. right. left. exists []. simpl.
        inversion H. exists l4.  split. split. reflexivity. reflexivity. reflexivity.
        inversion H. apply IHl4 in H2. destruct H2. destruct s. destruct s. exfalso.
        repeat destruct p. apply app_cons_not_nil in e0. assumption.
        destruct s. destruct s. destruct s. exfalso.
        repeat destruct p. apply app_cons_not_nil in e0. assumption.
        destruct s. destruct s. destruct s. exfalso.
        repeat destruct p. apply app_cons_not_nil in e0. assumption.
        destruct s. destruct s. destruct s. right. right. right.
        left. exists (a1 :: x). exists x0. simpl. repeat destruct p. rewrite e0.
        split. split. reflexivity. assumption. subst. reflexivity.
        destruct s. destruct s. right. right. right. right. exists x. exists x0.
        split. split. repeat destruct p. assumption. repeat destruct p. subst. reflexivity.
        repeat destruct p. subst. reflexivity. }
    + intros l4 l5 l6 l7 a0 E. destruct l6.
      { inversion E. right. right. left. exists []. exists l3. simpl. split. split. reflexivity. reflexivity. reflexivity. }
      { inversion E. apply IHl3 in H1. destruct H1.
        destruct s. destruct s. exfalso.
        repeat destruct p. apply app_cons_not_nil in e0. assumption.
        destruct s. destruct s. destruct s. exfalso.
        repeat destruct p. apply app_cons_not_nil in e0. assumption.
        destruct s. destruct s. destruct s. right. right. left. exists (a1 :: x).
        exists x0. repeat destruct p. rewrite e0. simpl. split. split. reflexivity. assumption. subst. reflexivity.
        right. right. right. destruct s. left. repeat destruct s. exists x. exists x0. repeat destruct p.
        split. split. assumption. assumption. simpl. subst. reflexivity.
        repeat destruct s. right. exists x. exists x0. repeat destruct p. split. split. assumption. assumption. subst. reflexivity. }
  * intros l3 l4 l5 l6 l7 a0 E. destruct l6. inversion E.
    { inversion E. right. left. exists []. exists l2. simpl. split. split. reflexivity. reflexivity. reflexivity. }
    { inversion E. apply IHl2 in H1. destruct H1.
      destruct s. destruct s. exfalso.
      repeat destruct p. apply app_cons_not_nil in e0. assumption.
      destruct s. destruct s. destruct s. right. left. exists (a1 :: x). exists x0.
      repeat destruct p. rewrite e. simpl. subst. split. split. reflexivity. reflexivity. reflexivity.
      right. right. destruct s. repeat destruct s. repeat destruct p. left. exists x. exists x0. subst. split. split. reflexivity.
      reflexivity. reflexivity.
      destruct s. repeat destruct s. repeat destruct p. subst. right. left. exists x. exists x0. subst. split. split. reflexivity.
      reflexivity. reflexivity.
      repeat destruct s. repeat destruct p. right. right. exists x. exists x0. subst. split. split. reflexivity.
      reflexivity. reflexivity. }
- intros l2 l3 l4 l5 l6 l7 a0 E. destruct l6.
  { inversion E. left. exists []. exists l1. auto. }
  { inversion E. apply IHl1 in H1. destruct H1.
    destruct s. destruct s. left. exists (a1 :: x). exists x0. repeat destruct p. rewrite e0. split.
    split. subst. reflexivity. subst. reflexivity. subst. reflexivity.
    destruct s.
    repeat destruct s. right. left. exists x. exists x0. repeat destruct p. subst. split. split. subst. reflexivity.
    reflexivity. reflexivity.
    destruct s.
    repeat destruct s. right. right. left. exists x. exists x0. repeat destruct p. subst. split. split. subst. reflexivity.
    reflexivity. reflexivity.
    destruct s.
    repeat destruct s. right. right. right. left. exists x. exists x0. repeat destruct p. subst. split. split. subst. reflexivity.
    reflexivity. reflexivity.
    destruct s.
    repeat destruct s. right. right. right. right. exists x. exists x0. repeat destruct p. subst. split. split. subst. reflexivity.
    reflexivity. reflexivity. }
Qed.

Lemma add_1_element_split_lists : forall {A : Type} (l1 l2 l3 l4 : list A) a,
    l1 ++ l2 = l3 ++ l4 -> ((l1 = l3) * (l2 = l4)) +
    (existsT2 l5 l6, ((l5 ++ a :: l6 ++ l2 = l3 ++ a :: l4) * (l5 ++ l6 = l1) * (l6 ++ l2 = l4) * (l5 = l3)) +
                     ((l1 ++ l5 ++ a :: l6 = l3 ++ a :: l4) * (l5 ++ l6 = l2) * (l1 ++ l5 = l3) * (l6 = l4))).
Proof.
intros A l1. induction l1.
- intros. rewrite app_nil_l in H. destruct l3.
  + left. rewrite app_nil_l in H. split. reflexivity. assumption.
  + right. exists (a0 :: l3). exists l4. right. split. split. split.
    rewrite app_nil_l. reflexivity. symmetry. assumption. rewrite app_nil_l.
    reflexivity. reflexivity.
- destruct l3.
  + intros. right. exists []. exists (a :: l1). left. split. split. split.
    repeat rewrite app_nil_l. rewrite H. reflexivity. rewrite app_nil_l. reflexivity.
    rewrite app_nil_l in H. assumption. reflexivity.
  + intros. inversion H. apply IHl1 with (a:=a1) in H2. destruct H2.
    * destruct p. subst. left. split. reflexivity. reflexivity.
    * destruct s. destruct s. destruct s.
      { repeat destruct p. subst. right. exists (a0 :: l3). exists x0.
        left. split. split. split. reflexivity. reflexivity. reflexivity.
        reflexivity. }
      { repeat destruct p. subst. right. exists x. exists l4. right. split. split. split.
        repeat rewrite app_assoc. reflexivity. reflexivity. reflexivity. reflexivity. }
Qed.

Lemma app2_find_hole {A : Type} : forall (l1 l2 l3 l4 : list A),
              l1 ++ l2 = l3 ++ l4 ->
              (existsT2 l5,
                ((l3 = l1) * (l4 = l2)) +
                ((l3 = l1 ++ l5) * (l2 = l5 ++ l4)) +
                ((l1 = l3 ++ l5) * (l4 = l5 ++ l2))).
Proof.
induction l1.
- intros. exists l3. left. right. split. reflexivity. assumption.
- intros l2 l3 l4 E. destruct l3.
  * rewrite app_nil_l in E. exists (a :: l1). right. split. reflexivity.
    symmetry. assumption.
  * inversion E. apply IHl1 in H1. destruct H1. destruct s.
    + destruct s.
      { destruct p. subst. exists []. left. left. auto. }
      { destruct p. subst. exists x. left. right. auto. }
    + destruct p. subst. exists x. right. auto.
Qed.

Theorem in_splitT : forall x (l:list (MPropF V)), In x l -> existsT2 l1 l2, l = l1++x::l2.
Proof.
intros x l. induction l.
- intro. inversion H.
- intro. destruct (eq_dec_form x a).
  * subst. exists nil. exists l. auto.
  * assert (In x l). inversion H. subst. exfalso. apply n. reflexivity. assumption.
    apply IHl in H0. destruct H0. destruct s. subst. exists ([a] ++ x0). exists x1.
    auto.
Qed.

Lemma InT_dec : forall l (a : MPropF V) , (InT a l) + ((InT a l) -> False).
Proof.
induction l.
- intro. right. intro. inversion H.
- intro a0. pose (IHl a0). destruct s.
  * left. apply InT_cons. assumption.
  * destruct (eq_dec_form a a0).
    + subst. left. apply InT_eq.
    + right. intro. inversion H.
      { apply n. assumption. }
      { apply f. assumption. }
Qed.

Lemma In_dec : forall l (a : MPropF V) , (In a l) + ((In a l) -> False).
Proof.
induction l.
- intro. right. intro. inversion H.
- intro a0. pose (IHl a0). destruct s.
  * left. apply in_cons. assumption.
  * destruct (eq_dec_form a a0).
    + subst. left. apply in_eq.
    + right. intro. inversion H.
      { apply n. assumption. }
      { apply f. assumption. }
Qed.

Lemma eq_dec_listsF : forall (l0 l1 : list (MPropF V)), {l0 = l1} + {l0 <> l1}.
Proof.
apply list_eq_dec. apply eq_dec_form.
Qed.

Lemma eq_dec_seqs : forall (s0 s1 : rel (list (MPropF V))), {s0 = s1} + {s0 <> s1}.
Proof.
intros. destruct s0. destruct s1. destruct (eq_dec_listsF l l1) ; destruct (eq_dec_listsF l0 l2).
- subst. left. reflexivity.
- subst. right. intro. inversion H. auto.
- subst. right. intro. inversion H. auto.
- subst. right. intro. inversion H. auto.
Qed.

Lemma seqs_in_splitT : forall (x : rel (list (MPropF V))) l,
       In x l -> existsT2 l1 l2, l = l1 ++ x :: l2.
Proof.
intros x l. induction l.
- intro. inversion H.
- intro. destruct (eq_dec_seqs x a).
  * subst. exists nil. exists l. auto.
  * assert (In x l). inversion H. subst. exfalso. apply n. reflexivity. assumption.
    apply IHl in H0. destruct H0. destruct s. subst. exists ([a] ++ x0). exists x1.
    auto.
Qed.

Lemma In_InT_seqs : forall (seq : rel (list (MPropF V))) seqs, In seq seqs -> InT seq seqs.
Proof.
intros seq seqs. induction seqs.
- intro. inversion H.
- intro. apply seqs_in_splitT in H. destruct H. destruct s. rewrite e. apply InT_or_app.
  right. apply InT_eq.
Qed.

Lemma list_split_form : forall (A B : MPropF V) l0 l1 l2 l3, (l0 ++ A :: l1 = l2 ++ B :: l3) ->
                          ((A = B) * (l0 = l2) * (l1 = l3)) +
                          (existsT2 l4 l5, (l0 = l4 ++ l5) * (l5 ++ A :: l1 = l3) * (l2 ++ [B] = l4)) +
                          (existsT2 l4 l5, (l1 = l4 ++ l5) * (l0 ++ A :: l4 = l2) * (B :: l3 = l5)).
Proof.
intros A B l0. generalize dependent A. generalize dependent B. induction l0.
- intros. simpl in H. destruct l2.
  * simpl in H. left. left. inversion H. auto.
  * simpl. inversion H. subst. right. exists l2. exists (B :: l3). auto.
- simpl. simpl in IHl0. intros. destruct l2.
  * left. right. simpl. exists [B]. exists l0. simpl. inversion H. subst. auto.
  * inversion H. subst. pose (@IHl0 B A l1 l2 l3 H2). repeat destruct s.
    + repeat destruct p. subst. left. left. auto.
    + repeat destruct p. subst. left. right. exists ((m :: l2) ++ [B]). exists x0.
      auto.
    + repeat destruct p. subst. right. exists x. exists (B :: l3). auto.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal27.

Set Printing Depth 1000.
Definition lfind_eval  n:=
Cons n Nil.

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ (Succ (Succ (Succ (Succ Zero))))).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).