Require Import Coq.Lists.List.
Require Import Coq.Program.Basics.
Require Import Coq.omega.Omega.
Require Import Coq.Classes.EquivDec.
Require Import Coq.Sorting.Permutation.
Require Import Coq.Bool.Bool.
Require Import Coq.Classes.EquivDec.

Require Import BWT.Lib.Sumbool.
Require Import BWT.Lib.EqDec.

Import Coq.Lists.List.ListNotations.

Section HeadTailInitLast.
  Context {A : Type}.

  (* Drop the last element of a list. *)
  Fixpoint init l : list A :=
    match l with
    | [] | [_] => []
    | hd :: tl => hd :: init tl
    end.

  Lemma last2 : forall (l : list A) (a b d : A),
      last (a :: b :: l) d = last (b :: l) d.
  Proof.
    reflexivity.
  Qed.

  Lemma init2 : forall (l : list A) (a b : A),
      init (a :: b :: l) = a :: init (b :: l).
  Proof.
    reflexivity.
  Qed.

  (* An induction scheme that considers the singleton list as a
     separate case and steps by two elements at a time. *)
  Theorem list_ind2 : forall (P : list A -> Prop),
      P [] ->
      (forall a, P [a]) ->
      (forall a b l, P (b :: l) -> P (a :: b :: l)) ->
      forall l : list A, P l.
  Proof.
    intros P HBase HOne HInd.
    refine (
        fix F l : P l :=
          match l as l' return l = l' -> P l' with
          | []  => fun _ => HBase
          | [x] => fun _ => HOne x
          | a :: tl => fun HL => _
          end eq_refl
      ).
    destruct l. rewrite <- HL. exact HBase.
    inversion HL. apply HInd. rewrite <- H1. apply F.
  Qed.

  Lemma last_app : forall (l: list A) (x d: A),
      last (l ++ [x]) d = x.
  Proof.
    induction l as [| x | a b tl IH] using list_ind2;
      intros; try reflexivity.
    do 2 rewrite <- app_comm_cons.
    rewrite last2.
    apply IH.
  Qed.

  Lemma init_app : forall (x y: list A) a,
      init (x ++ a :: y) = x ++ init (a :: y).
  Proof.
    induction x as [| x | a b tl IH] using list_ind2;
      intros; try reflexivity.
    do 2 rewrite <- app_comm_cons.
    rewrite init2.
    rewrite <- app_comm_cons at 1.
    f_equal.
    apply IH.
  Qed.

  Lemma l_app_nil_inv : forall (a b : A) (l : list A),
      l ++ [b] = [a] -> l = [] /\ a = b.
  Proof.
    destruct l as [|hd tl].
    - split; auto. rewrite app_nil_l in H.
      inversion H; auto.
    - intros contra. inversion contra.
      symmetry in H1. apply app_cons_not_nil in H1. contradiction.
  Qed.

  Lemma last_nonempty : forall (l: list A) d d',
      l <> [] -> last l d = last l d'.
  Proof.
    induction l as [| a | a b tl IH] using list_ind2;
      intros; try contradiction; clear H.
    - reflexivity.
    - do 2 rewrite last2.
      apply IH.
      intro contra; inversion contra.
  Qed.

  Lemma hd_tl_destr : forall (x : A) xs d,
      x :: xs = (hd d (x :: xs)) :: (tl (x :: xs)).
  Proof.
    reflexivity.
  Qed.

  Lemma init_last_destr : forall xs x d,
      x :: xs = init (x :: xs) ++ [last (x :: xs) d].
  Proof.
    induction xs; intros.
    - reflexivity.
    - rewrite init2. rewrite <- app_comm_cons.
      f_equal. rewrite last2.
      apply IHxs.
  Qed.

  Lemma tl_len : forall l : list A,
      length (tl l) = Nat.pred (length l).
  Proof.
    induction l; reflexivity.
  Qed.

  Lemma init_len : forall l : list A,
      length (init l) = Nat.pred (length l).
  Proof.
    induction l using list_ind2; intros; try reflexivity.
    rewrite init2.
    replace (length (a :: _)) with (S (length (init (b :: l)))) by reflexivity.
    rewrite IHl. reflexivity.
  Qed.

  Lemma firstn_init : forall j l,
      j < length l ->
      firstn j (init l) = firstn j l.
  Proof.
    intros j l; revert j; induction l; intros j; [reflexivity|].
    cbn [length]; intros HJ.
    destruct j; [reflexivity|].
    assert (j < length l) by omega; clear HJ.
    destruct l as [|b l]; [cbn in H; omega|].
    rewrite init2. cbn [firstn]. f_equal. apply IHl. auto.
  Qed.
End HeadTailInitLast.

Section Forall2.
  Lemma Forall2_eq {A : Type} : forall x y : list A,
      Forall2 eq x y <-> x = y.
  Proof.
    split; intros.
    - induction H.
      + reflexivity.
      + subst. f_equal.
    - subst. induction y; constructor; auto.
  Qed.

  Theorem Forall2_length {A : Type} : forall (R : A -> A -> Prop) (l l' : list A),
      Forall2 R l l' ->
      length l = length l'.
  Proof.
    intros R l l' HF.
    induction HF; cbn; auto.
  Qed.

  Lemma Forall2_map {A B : Type} (R : B -> B -> Prop) : forall (f : A -> B) (l l' : list A),
      Forall2 R (map f l) (map f l') <-> Forall2 (fun x y => R (f x) (f y)) l l'.
  Proof.
    induction l; intros.
    - split; intros H; replace l' with (@nil A); [constructor| |constructor|].
      + cbn in H. inversion H. symmetry in H0. apply map_eq_nil in H0. auto.
      + inversion H. auto.
    - destruct l' as [|a' l']; [split; cbn; intros H; inversion H|].
      simpl; split; intros HImp; inversion HImp; subst; clear HImp; constructor; auto; apply IHl; auto.
  Qed.

  Lemma Forall2_impl : forall (A B : Type) (P Q : A -> B -> Prop),
      (forall a b, P a b -> Q a b) -> forall l l', Forall2 P l l' -> Forall2 Q l l'.
  Proof.
    intros. induction H0; constructor; auto.
  Qed.

  Lemma Forall_rev {A} : forall P (x y : list A),
      Forall2 P x y -> Forall2 P (rev x) (rev y).
  Proof.
    induction x; intros y HF; [inversion HF; subst; easy|].
    destruct y as [|b y]; [inversion HF|].
    inversion HF; subst; clear HF.
    cbn. apply Forall2_app; [apply IHx; easy|].
    constructor; easy.
  Qed.
End Forall2.

Section Map.
  Open Scope program_scope.

  Lemma eq_map {A B : Type} (f g : A -> B) l :
    (forall x, f x = g x) -> map f l = map g l.
  Proof.
    intros HExt; induction l; try reflexivity.
    simpl; rewrite HExt, IHl.
    reflexivity.
  Qed.

  Lemma map_map' {A B C : Type} : forall (f : A -> B) (g : B -> C) l,
      map g (map f l) = map (g ∘ f) l.
  Proof.
    intros.
    rewrite map_map. apply eq_map.
    reflexivity.
  Qed.

  Lemma map_injective {A B : Type} : forall (f : A -> B) l l',
      (forall x y, f x = f y -> x = y) ->
      map f l = map f l' -> l = l'.
  Proof.
    intros f l l' HInj MapEq.
    assert (length l = length l'). {
      rewrite <- map_length with (f := f), MapEq, -> map_length.
      easy.
    }
    assert (Forall2 (fun x y => f x = f y) l l'). {
      apply Forall2_eq in MapEq.
      apply (proj1 (Forall2_map eq f l l')) in MapEq.
      apply MapEq.
    }
    apply Forall2_eq.
    eapply Forall2_impl; [| apply H0].
    cbv beta; intros. auto.
  Qed.

  Lemma map_forall_eq {A B : Type} : forall (l : list A) (f g : A -> B),
      Forall (fun x => f x = g x) l -> map f l = map g l.
  Proof.
    induction l; intros.
    - reflexivity.
    - inversion H; subst; clear H.
      simpl. f_equal; auto.
  Qed.

  Lemma map_const {A B} : forall (f : A -> B) l c,
      (forall x, f x = c) -> map f l = repeat c (length l).
  Proof.
    intros.
    induction l; [reflexivity|].
    simpl. rewrite H. f_equal. auto.
  Qed.
End Map.

Section Filter.
  Context {A : Type}.

  Implicit Types (l : list A) (f : A -> bool).

  Remark filter_app: forall f l l',
      filter f (l ++ l') = filter f l ++ filter f l'.
  Proof.
    induction l; intros; simpl. auto.
    destruct (f a); simpl. f_equal; auto. auto.
  Qed.

  Remark filter_empty: forall f l,
      (forall x, In x l -> f x = false) ->
      filter f l = nil.
  Proof.
    induction l; simpl; intros.
    auto.
    rewrite (H a (or_introl eq_refl)).
    apply IHl. auto.
  Qed.

  Remark filter_sublist: forall f x l l1' l2',
      filter f l = l1' ++ x :: l2' ->
      exists l1, exists l2, l = l1 ++ x :: l2 /\ filter f l1 = l1' /\ filter f l2 = l2'.
  Proof.
    induction l; intros until l2'; simpl.
    intro. destruct l1'; simpl in H; discriminate.
    case_eq (f a); intros.
    destruct l1'; simpl in H0; injection H0; clear H0; intros.
    subst x. exists (@nil A); exists l. auto.
    subst a0. destruct (IHl _ _ H0) as [l1 [l2 [P [Q R]]]]. subst l.
    exists (a :: l1); exists l2.
    split. auto. split. simpl. rewrite H. congruence. auto.
    destruct (IHl _ _ H0) as [l1 [l2 [P [Q R]]]]. subst l.
    exists (a :: l1); exists l2.
    split. auto. split. simpl. rewrite H. auto. auto.
  Qed.

  Section CountOcc.
    (* Decidable leibniz equality *)
    Variable eq_dec : forall x y : A, { x = y } + { x <> y }.

    Theorem filter_true_count_occ : forall f a l,
      (f a = true) ->
      count_occ eq_dec (filter f l) a = count_occ eq_dec l a.
    Proof.
      induction l as [|h t IH]; intros HF; [reflexivity|].
      cbn. destruct (eq_dec h a).
      - rewrite e, HF.
        cbn; rewrite if_true by auto; auto.
      - destruct (f h); cbn.
        + rewrite if_false by auto; auto.
        + apply IH; auto.
    Qed.

    Theorem filter_false_count_occ: forall f a l,
        (f a = false) ->
        count_occ eq_dec (filter f l) a = 0.
    Proof.
      induction l as [|h t IH]; intros HF; [reflexivity|].
      cbn; destruct (f h) eqn:HFh; cbn.
      - destruct (eq_dec h a).
        + exfalso; apply diff_false_true.
          rewrite <- HF, <- HFh, e; reflexivity.
        + apply IH; auto.
      - apply IH; auto.
    Qed.
  End CountOcc.
End Filter.

Section Rem1.
  Context {A : Type}.

  Variable eq_dec : forall x y : A, { x = y } + { x <> y }.

  Fixpoint rem1 (x : A) (l : list A) : list A
    := match l with
       | [] => []
       | h :: t => if eq_dec x h then t else h :: rem1 x t
       end.

  Theorem rem1_in_split : forall x a,
      In a x ->
      exists l1 l2, x = l1 ++ a :: l2 /\ rem1 a x = l1 ++ l2.
  Proof.
    induction x as [|hx tx]; intros a HIn; [inversion HIn|].
    cbn [rem1].
    destruct (eq_dec a hx).
    + subst.
      exists [], tx. split; cbn; auto.
    + destruct (IHtx a) as [l1 [l2 [Htx Hrem]]].
      destruct HIn; [rewrite H in n; exfalso; apply n; reflexivity|auto].
      exists (hx :: l1), l2.
      split; [rewrite Htx; reflexivity|].
      cbn. f_equal. auto.
  Qed.

  Theorem Permutation_rem1_cons : forall x a y,
      Permutation (a :: x) y -> Permutation x (rem1 a y).
  Proof.
    intros x a y HP.
    destruct (rem1_in_split y a) as [l1 [l2 [Hy Hyrem]]].
    eapply Permutation_in; [apply HP|left; auto].
    rewrite Hyrem.
    apply Permutation_cons_inv with (a := a).
    transitivity y; [auto|].
    rewrite Hy. symmetry. apply Permutation_cons_app.
    reflexivity.
  Qed.

  Theorem in_rem1_in : forall a b x,
      In a (rem1 b x) -> In a x.
  Proof.
    intros a b x. revert a b.
    induction x as [|h t]; intros a b HIn; [inversion HIn|].
    cbn in *. destruct (eq_dec b h).
    - right; auto.
    - destruct HIn.
      + left; auto.
      + right; eapply IHt. apply H.
  Qed.

  Theorem in_in_rem1_neq : forall a b x,
       In a x -> In a (rem1 b x) \/ a = b.
  Proof.
    intros a b x.
    destruct (eq_dec a b); [auto|].
    induction x as [|h t]; intros HIn; [inversion HIn|left].
    cbn. destruct (eq_dec b h).
    - destruct HIn; [|auto].
      exfalso. apply n. symmetry. transitivity h; auto.
    - destruct HIn; [left; auto|].
      destruct IHt; [|right|exfalso; apply n]; auto.
  Qed.

  Theorem rem1_not_in : forall l x,
      ~ (In x l) -> rem1 x l = l.
  Proof.
    induction l; intros x HNIn; [reflexivity|].
    cbn. destruct (eq_dec x a).
    exfalso. apply HNIn. left. symmetry. apply e.
    f_equal. apply IHl. intro c2.
    apply HNIn. right. apply c2.
  Qed.

  Theorem rem1_app_1 : forall l1 l2 x,
      In x l1 -> rem1 x (l1 ++ l2) = rem1 x l1 ++ l2.
  Proof.
    induction l1; intros l2 x HIn; [inversion HIn|].
    destruct HIn.
    - subst. cbn. destruct (eq_dec x x); [|exfalso; apply n; reflexivity].
      reflexivity.
    - cbn.
      destruct (eq_dec x a); [reflexivity|].
      cbn. f_equal. apply IHl1. auto.
  Qed.

  Theorem rem1_app_2 : forall l1 l2 x,
      ~ In x l1 -> rem1 x (l1 ++ l2) = l1 ++ rem1 x l2.
  Proof.
    induction l1; intros l2 x HIn; [reflexivity|].
    cbn. destruct (eq_dec x a).
    exfalso. apply HIn. left. symmetry. apply e.
    f_equal. apply IHl1. intro c2. apply HIn. right. auto.
  Qed.

  Theorem Permutation_rem1 : forall x y a,
      Permutation x y -> Permutation (rem1 a x) (rem1 a y).
  Proof.
    intros x y a HP. revert a.
    induction HP; intros a.
    - apply perm_nil.
    - cbn. destruct (eq_dec a x); auto.
    - cbn. destruct (eq_dec a y); destruct (eq_dec a x); subst; auto.
      apply perm_swap.
    - transitivity (rem1 a l'); auto.
  Qed.

  Theorem count_occ_rem1_eq : forall l a,
      In a l ->
      count_occ eq_dec l a = S (count_occ eq_dec (rem1 a l) a).
  Proof.
    induction l as [|h t IH]; intros a HIn; [inversion HIn|].
    destruct HIn.
    - subst. cbn. rewrite !if_true by reflexivity.
      reflexivity.
    - cbn. destruct (eq_dec h a).
      + rewrite if_true by (symmetry; auto).
        reflexivity.
      + rewrite if_false by (apply not_eq_sym; auto); cbn.
        rewrite if_false by auto.
        apply IH; auto.
  Qed.

  Theorem count_occ_rem1_neq : forall l a x,
      a <> x ->
      count_occ eq_dec l a = count_occ eq_dec (rem1 x l) a.
  Proof.
    induction l as [|h t IH]; intros a x HNeq; [reflexivity|].
    cbn. destruct (eq_dec h a).
    - rewrite if_false by (rewrite e; auto).
      cbn. rewrite if_true by auto.
      f_equal; apply IH; auto.
    - destruct (eq_dec x h); [reflexivity|].
      cbn. rewrite if_false by auto.
      apply IH; auto.
  Qed.

  Theorem filter_rem1 : forall f l a,
      filter f (rem1 a l) = rem1 a (filter f l).
  Proof.
    intros f; induction l as [|h t IH]; intros a; [reflexivity|].
    cbn. destruct (eq_dec a h).
    - destruct (f h) eqn:FH.
      + cbn. rewrite if_true by auto. reflexivity.
      + rewrite rem1_not_in; [reflexivity|].
        intro c. apply diff_true_false.
        apply filter_In in c.
        destruct c as [_ c].
        rewrite e in c.
        rewrite <- FH, <- c.
        reflexivity.
    - cbn. destruct (f h).
      + cbn. rewrite if_false by auto.
        f_equal. apply IH.
      + apply IH.
  Qed.
End Rem1.

Section Nth.
  Context {A : Type}.

  Lemma nth_eq : forall l l' : list A,
      length l = length l' ->
      (forall i d, i < length l -> nth i l d = nth i l' d) <-> l = l'.
  Proof.
    induction l; intros l' L.
    - split; intros.
      + symmetry. apply length_zero_iff_nil. auto.
      + subst. reflexivity.
    - split; intros.
      + destruct l'. simpl in L. omega.
      f_equal.
        * apply (H 0 a). simpl; omega.
        * apply IHl; auto.
          intros i d.
          specialize (H (S i) d).
          simpl in H. intro; apply H; omega.
      + rewrite H. reflexivity.
  Qed.

  Lemma nth_first : forall (l : list A) d,
      nth 0 l d = hd d l.
  Proof.
    destruct l; reflexivity.
  Qed.

  Lemma nth_last : forall (l : list A) d,
      nth (Nat.pred (length l)) l d = last l d.
  Proof.
    induction l using list_ind2; intros; try reflexivity.
    replace (last (a :: b :: l)) with (last (b :: l)) by reflexivity.
    replace (length (a :: b :: l)) with (S (length (b :: l))) by reflexivity.
    unfold Nat.pred.
    replace (nth _ _ _)
    with (nth (Nat.pred (length (b ::l))) (b :: l) d) by reflexivity.
    apply IHl.
  Qed.
End Nth.

Section Pairs.
  Context {A B : Type}.

  Lemma not_in_pair : forall (l : list (A * B)) a b,
       ~ In a (fst (split l)) \/ ~ In b (snd (split l)) -> ~ In (a, b) l.
  Proof.
    intros l a b.
    remember (a, b) as p;
    replace a with (fst p) by (subst; easy); replace b with (snd p) by (subst; easy).
    intros []; intro c; [apply in_split_l in c|apply in_split_r in c]; contradiction.
  Qed.

  Theorem NoDup_pair : forall l : list (A * B),
      NoDup (fst (split l)) \/ NoDup (snd (split l)) -> NoDup l.
  Proof.
    induction l; cbn; [intuition constructor|].
    destruct a; cbn. destruct (split l) eqn:HS. cbn.
    intros []; inversion H; subst; clear H;
      (constructor; [apply not_in_pair; rewrite HS; auto|apply IHl; intuition]).
  Qed.

  Lemma map_split : forall l : list (A * B),
      split l = (map fst l, map snd l).
  Proof.
    induction l as [|[a b] l]; [reflexivity|]; cbn; destruct (split l).
    inversion IHl; subst. easy.
  Qed.
End Pairs.

Section Seq.
  Lemma seq_split : forall i j s,
      seq s (i + j) = seq s i ++ seq (s + i) j.
  Proof.
    induction i as [|i IH]; intros j s;
      [cbn; rewrite Nat.add_0_r; reflexivity|].
    cbn; f_equal.
    rewrite IH; f_equal.
    rewrite <- plus_Snm_nSm.
    reflexivity.
  Qed.

  Lemma seq_last_perm : forall p n,
      Permutation (n :: p) (seq 0 (S n)) ->
      Permutation p (seq 0 n).
  Proof.
    intros p n HP.
    replace (S n) with (n + 1) in HP by omega.
    rewrite seq_split with (i := n) (j := 1) in HP.
    cbn in HP.
    rewrite Permutation_app_comm in HP.
    eapply Permutation_cons_inv. apply HP.
  Qed.
End Seq.

Section FirstnSkipn.
  Context {A : Type}.

  Implicit Type l : list A.

  Lemma firstn_skipn_nth : forall l i d,
      i < length l ->
      firstn 1 (skipn i l) = [nth i l d].
  Proof.
    induction l; intros i d HL; [cbn in HL; omega|].
    destruct i; [easy|].
    cbn [skipn nth]. apply IHl. cbn in HL; omega.
  Qed.

  Lemma firstn_skipn_split : forall l i d,
      0 < i < length l ->
      l = firstn i l ++ nth i l d :: skipn (S i) l.
  Proof.
    intros l i d HL.
    destruct i; [omega|].
    rewrite <- firstn_skipn with (l := l) (n := S (S i)) at 1.
    replace (S (S i)) with (S i + 1) at 1 by omega.
    rewrite <- firstn_skipn with (l := l) (n := S i) at 1.
    rewrite firstn_app, firstn_length, Nat.min_l by omega.
    replace (S i + 1 - S i) with 1 by omega.
    rewrite firstn_firstn, Nat.min_r by omega.
    rewrite firstn_skipn_nth with (d := d) by omega.
    rewrite <- app_assoc.
    reflexivity.
  Qed.

  Theorem firstn_nth : forall n (l : list A) i d,
      i < n ->
      nth i (firstn n l) d = nth i l d.
  Proof.
    induction n as [|n IH]; intros l i d HI; [omega|].
    destruct l; [destruct i; easy|].
    destruct i; [easy|].
    cbn [firstn nth]. apply IH; omega.
  Qed.
End FirstnSkipn.

Section RemNth.
  Context {A : Type}.

  Implicit Type l : list A.

  Fixpoint rem_nth i l :=
    match l with
    | [] => []
    | h :: t =>
      match i with
      | 0 => t
      | S i' => h :: rem_nth i' t
      end
    end.

  Remark rem_nth_nil : forall i,
      rem_nth i [] = [].
  Proof. intros []; easy. Qed.

  Remark rem_nth_zero : forall a l,
      rem_nth 0 (a :: l) = l.
  Proof. easy. Qed.

  Theorem rem_nth_length : forall l i,
      i < length l ->
      length (rem_nth i l) = pred (length l).
  Proof.
    induction l; intros i HI; [cbn in HI; omega|].
    cbn in *. destruct i; [easy|].
    cbn. rewrite IHl by omega.
    destruct l; [omega|easy].
  Qed.

  Theorem nth_lt_rem_nth : forall i j l d,
      j < i ->
      nth j (rem_nth i l) d = nth j l d.
  Proof.
    induction i as [|i IH]; intros j l d HIJ; [omega|].
    destruct l; [cbn [rem_nth]; easy|].
    cbn [rem_nth].
    destruct j; cbn [nth]; [easy|].
    apply IH; omega.
  Qed.

  Theorem nth_ge_rem_nth : forall i j l d,
      j >= i ->
      nth j (rem_nth i l) d = nth (S j) l d.
  Proof.
    induction i as [|i IH]; intros j l d HIJ.
    - destruct l; cbn [rem_nth tl];
        [rewrite !nth_overflow by (cbn; omega); easy|].
      easy.
    - destruct l; cbn [rem_nth tl];
        [rewrite !nth_overflow by (cbn; omega); easy|].
      destruct j; [omega|].
      cbn [nth]. apply IH. omega.
  Qed.

  Theorem rem_nth_Perm : forall l i d,
      i < length l ->
      Permutation l (nth i l d :: rem_nth i l).
  Proof.
    induction l; intros i d HI; [cbn in*; omega|].
    destruct i; [reflexivity|].
    cbn. etransitivity; [|apply perm_swap].
    apply perm_skip. apply IHl. cbn in *; omega.
  Qed.

  Theorem rem_nth_app_1 : forall l1 l2 i,
      i >= length l1 ->
      rem_nth i (l1 ++ l2) = l1 ++ rem_nth (i - length l1) l2.
  Proof.
    induction l1; intros l2 i HI; [rewrite <- minus_n_O; easy|].
    cbn in HI. destruct i; [omega|].
    cbn. f_equal.
    apply IHl1. omega.
  Qed.

  Theorem rem_nth_app_2 : forall l1 l2 i,
      i < length l1 ->
      rem_nth i (l1 ++ l2) = rem_nth i l1 ++ l2.
  Proof.
    induction l1; intros l2 i HI; [rewrite app_nil_l; easy|].
    cbn in HI. destruct i; [easy|].
    cbn. f_equal.
    apply IHl1. omega.
  Qed.

  Theorem rem_nth_split : forall l i,
      i < length l ->
      rem_nth i l = firstn i l ++ skipn (S i) l.
  Proof.
    intros l i HI.
    destruct i; [destruct l; easy|].
    destruct l as [|d t] eqn:HL; [easy|rewrite <- HL in *; clear t HL].
    rewrite @firstn_skipn_split with (i := S i) (d := d) (l := l) at 1 by omega.
    rewrite rem_nth_app_1 by (rewrite firstn_length, Nat.min_l; omega).
    f_equal. rewrite firstn_length, Nat.min_l by omega.
    replace (S i - S i) with 0 by omega.
    easy.
  Qed.
End RemNth.

Theorem rem_nth_combine {A} {B} : forall (l : list A) (r : list B) i,
    rem_nth i (combine l r) = combine (rem_nth i l) (rem_nth i r).
Proof.
  induction l as [|xl l IH]; intros r i.
  - rewrite rem_nth_nil. cbn. apply rem_nth_nil.
  - destruct r as [|xr r];
      [rewrite rem_nth_nil; destruct i; destruct l; easy|].
    destruct i; [easy|].
    cbn; f_equal.
    apply IH.
Qed.

Theorem in_eq_iff {A : Type} : forall l l' : list A,
    l = l' -> (forall x, In x l <-> In x l').
Proof.
  intros l l' Heq.
  rewrite Heq. intros; reflexivity.
Qed.

Lemma length_nonempty_destr {A} : forall (xs : list A) l,
    S l <= length xs ->
    (xs <> []) * A.
Proof.
  intros [|h t] l.
  - simpl; omega.
  - simpl; intro HL; split.
    + intro c; inversion c.
    + exact h.
Qed.

Theorem Exists_impl {A} : forall (P Q : A -> Prop) l,
    Exists P l -> (forall x, P x -> Q x) -> Exists Q l.
Proof.
  intros P Q l HE HI.
  apply Exists_exists in HE.
  destruct HE as [x [HIn HP]].
  apply Exists_exists. exists x.
  split; auto.
Qed.

Theorem in_cons_neq {A} : forall (x y : A) l,
    x <> y -> In x (y :: l) -> In x l.
Proof. intros x y l NEQ []; intuition. Qed.

Section Forall.
  Context {A : Type}.

  Implicit Type l : list A.

  Theorem Forall_app : forall P l1 l2,
      Forall P (l1 ++ l2) <-> Forall P l1 /\ Forall P l2.
  Proof.
    intros P l1 l2.
    rewrite !Forall_forall.
    setoid_rewrite in_app_iff.
    intuition.
  Qed.

  Theorem Forall_nth : forall P l,
      Forall P l <-> (forall i d, i < length l -> P (nth i l d)).
  Proof.
    intros P l.
    split.
    - intros HF i d HI.
      eapply Forall_forall; [apply HF|].
      apply nth_In; easy.
    - intros HP.
      apply Forall_forall; intros x HIn.
      destruct (In_nth _ _ x HIn) as [i [HI Hx]].
      rewrite <- Hx.
      apply HP; easy.
  Qed.
End Forall.

Section CountOcc.
  Context {A : Type} `(ED : EqDec A eq).

  Implicit Type l : list A.

  Lemma count_occ_remove_eq : forall a l r,
    count_occ equiv_dec (l ++ a :: r) a = S (count_occ equiv_dec (l ++ r) a).
  Proof.
    induction l as [|x l IH]; intros r.
    - cbn. rewrite if_true by reflexivity. easy.
    - cbn. destruct (x == a); rewrite IH; reflexivity.
  Qed.

  Lemma count_occ_remove_neq : forall a l r x,
      a <> x ->
      count_occ equiv_dec (l ++ a :: r) x = count_occ equiv_dec (l ++ r) x.
  Proof.
    induction l as [|y l IH]; intros r x HNeq.
    - cbn. rewrite if_false by easy. easy.
    - cbn. destruct (y == x); rewrite IH; easy.
  Qed.
End CountOcc.


Require Export Lists_J.

Inductive boollist : Type :=
  | bool_nil : boollist
  | bool_cons : bool -> boollist -> boollist.

Inductive list (X:Type) : Type :=
  | nil
  | cons (x : X) (l : list X).

Check (cons nat 2 (cons nat 1 (nil nat))).

Fixpoint repeat (X : Type) (x : X) (count : nat) : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat X x count')
  end.

Example test_repeat1 :
  repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)).
Proof. reflexivity. Qed.

Module MumbleGrumble.
Inductive mumble : Type :=
  | a
  | b (x : mumble) (y : nat)
  | c.
Inductive grumble (X:Type) : Type :=
  | d (m : mumble)
  | e (x : X).
End MumbleGrumble.
(* Definition manual_grade_for_mumble_grumble : option (nat*string) := None. *)

Fixpoint repeat' X x count : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat' X x count')
  end.

Arguments nil {X}.
Arguments cons {X} _ _.
Arguments repeat {X} x count.

Definition list123'' := cons 1 (cons 2 (cons 3 nil)).

Fixpoint repeat''' {X : Type} (x : X) (count : nat) : list X :=
  match count with
  | 0 => nil
  | S count' => cons x (repeat''' x count')
  end.

Inductive list' {X:Type} : Type :=
  | nil'
  | cons' (x : X) (l : list').

Fixpoint app {X : Type} (l1 l2 : list X)
             : (list X) :=
  match l1 with
  | nil => l2
  | cons h t => cons h (app t l2)
  end.
Fixpoint rev {X:Type} (l:list X) : list X :=
  match l with
  | nil => nil
  | cons h t => app (rev t) (cons h nil)
  end.
Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
  | nil => 0
  | cons _ l' => S (length l')
  end.
Example test_rev1 :
  rev (cons 1 (cons 2 nil)) = (cons 2 (cons 1 nil)).
Proof. reflexivity. Qed.
Example test_rev2:
  rev (cons true nil) = cons true nil.
Proof. reflexivity. Qed.
Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3.
Proof. reflexivity. Qed.

Fail Definition mynil := nil.

Definition mynil : list nat := nil.

Definition mynil' := @nil nat.

Notation "x :: y" := (cons x y)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                     (at level 60, right associativity).

Definition list123''' := [1; 2; 3].

Theorem app_nil_r : forall(X:Type), forall l:list X,
  l ++ [] = l.
Proof.
  (* FILL IN HERE *) Admitted.
Theorem app_assoc : forall A (l m n:list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  (* FILL IN HERE *) Admitted.
Lemma app_length : forall(X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
(* FILL IN HERE *) Admitted.

Theorem rev_app_distr: forall X (l1 l2 : list X),
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  (* FILL IN HERE *) Admitted.
Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
(* FILL IN HERE *) Admitted.

Inductive prod (X Y : Type) : Type :=
| pair (x : X) (y : Y).
Arguments pair {X} {Y} _ _.

Notation "( x , y )" := (pair x y).

Notation "X * Y" := (prod X Y) : type_scope.

Definition fst {X Y : Type} (p : X * Y) : X :=
  match p with
  | (x, y) => x
  end.

Definition snd {X Y : Type} (p : X * Y) : Y :=
  match p with
  | (x, y) => y
  end.

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
           : list (X*Y) :=
  match lx, ly with
  | [], _ => []
  | _, [] => []
  | x :: tx, y :: ty => (x, y) :: (combine tx ty)
  end.

Compute (combine [1;2] [false;false;true;true]).

Inductive option (X:Type) : Type :=
  | Some : X -> option X
  | None : option X.

Arguments Some {X} _.
Arguments None {X}.
Fixpoint index {X : Type} (n : nat)
               (l : list X) : option X :=
  match l with
  | [] => None
  | a :: l' => if beq_nat n O then Some a else index (pred n) l'
  end.

Example test_index1 : index 0 [4;5;6;7] = Some 4.
Proof. reflexivity. Qed.
Example test_index2 : index 1 [[1];[2]] = Some [2].
Proof. reflexivity. Qed.
Example test_index3 : index 2 [true] = None.
Proof. reflexivity. Qed.

Definition doit3times {X:Type} (f:X->X) (n:X) : X :=
  f (f (f n)).

Fixpoint filter {X:Type} (test: X->bool) (l:list X)
                : (list X) :=
  match l with
  | [] => []
  | h :: t => if test h then h :: (filter test t)
                        else filter test t
  end.

Example test_filter1: filter evenb [1;2;3;4] = [2;4].
Proof. reflexivity. Qed.
(* Definition length_is_1 {X : Type} (l : list X) : bool := *)
(*   (length l) =? 1. *)
(* Example test_filter2: *)
(*     filter length_is_1 *)
(*            [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] *)
(*   = [ [3]; [4]; [8] ]. *)
(* Proof. reflexivity. Qed. *)

Definition countoddmembers' (l:list nat) : nat :=
  length (filter oddb l).
Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.
Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0.
Proof. reflexivity. Qed.
Example test_countoddmembers'3: countoddmembers' nil = 0.
Proof. reflexivity. Qed.

(* Example test_filter2': *)
(*     filter (fun l => (length l) =? 1) *)
(*            [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] *)
(*   = [ [3]; [4]; [8] ]. *)
(* Proof. reflexivity. Qed. *)

Definition partition {X : Type}
                     (test : X -> bool)
                     (l : list X)
                   : list X * list X
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Fixpoint map {X Y: Type} (f:X->Y) (l:list X) : (list Y) :=
  match l with
  | [] => []
  | h :: t => (f h) :: (map f t)
  end.

Theorem map_rev : forall(X Y : Type) (f : X -> Y) (l : list X),
  map f (rev l) = rev (map f l).
Proof.
(* FILL IN HERE *) Admitted.

Fixpoint fold {X Y: Type} (f: X->Y->Y) (l: list X) (b: Y)
                         : Y :=
  match l with
  | nil => b
  | h :: t => f h (fold f t b)
  end.

Definition constfun {X: Type} (x: X) : nat->X :=
  fun (k:nat) => x.
Definition ftrue := constfun true.

Definition prod_curry {X Y Z : Type}
  (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).

Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z :=
   admit.

Theorem uncurry_curry : forall (X Y Z : Type) (f : X -> Y -> Z) x y,
  prod_curry (prod_uncurry f) x y = f x y.
Proof.
Admitted.

Theorem curry_uncurry : forall (X Y Z : Type)
                               (f : (X * Y) -> Z) (p : X * Y),
  prod_uncurry (prod_curry f) p = f p.
Proof.
Admitted.

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
                      : option Y :=
  match xo with
    | None => None
    | Some x => Some (f x)
  end.

Check plus.
Definition plus3 := plus 3.
Check plus3.
Example test_plus3 : plus3 4 = 7.
Proof. reflexivity. Qed.
Example test_plus3' : doit3times plus3 0 = 9.
Proof. reflexivity. Qed.
Example test_plus3'' : doit3times (plus 3) 0 = 9.
Proof. reflexivity. Qed.

Definition override {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:=
  fun (k':nat) => if beq_nat k k' then x else f k'.

Theorem unfold_example : forall m n,
  3 + n = m ->
  plus3 n + 1 = m + 1.
Proof.
  intros m n H.
  unfold plus3.
  rewrite -> H.
  reflexivity. Qed.

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
Admitted.

Theorem override_eq : forall {X:Type} x k (f:nat->X),
  (override f k x) k = x.
Proof.
  intros X x k f.
  unfold override.
  rewrite <- beq_nat_refl.
  reflexivity. Qed.

Theorem override_neq : forall {X:Type} x1 x2 k1 k2 (f : nat->X),
  f k1 = x1 ->
  beq_nat k2 k1 = false ->
  (override f k2 x2) k1 = x1.
Proof.
Admitted.

Theorem eq_add_S : forall (n m : nat),
     S n = S m ->
     n = m.
Proof.
  intros n m eq. inversion eq. reflexivity. Qed.

Theorem silly4 : forall (n m : nat),
     [n] = [m] ->
     n = m.
Proof.
  intros n o eq. inversion eq. reflexivity. Qed.

Theorem silly5 : forall (n m o : nat),
     [n;m] = [o;o] ->
     [n] = [m].
Proof.
  intros n m o eq. inversion eq. reflexivity. Qed.

Theorem S_inj : forall (n m : nat) (b : bool),
     beq_nat (S n) (S m) = b ->
     beq_nat n m = b.
Proof.
  intros n m b H. simpl in H. apply H. Qed.

Theorem silly3' : forall (n : nat),
  (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
     true = beq_nat n 5 ->
     true = beq_nat (S (S n)) 7.
Proof.
  intros n eq H.
  symmetry in H. apply eq in H. symmetry in H.
  apply H. Qed.

Definition sillyfun (n : nat) : bool :=
  if beq_nat n 3 then false
  else if beq_nat n 5 then false
  else false.

Theorem sillyfun_false : forall (n : nat),
  sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (beq_nat n 3).
    Case "beq_nat n 3 = true". reflexivity.
    Case "beq_nat n 3 = false". destruct (beq_nat n 5).
      SCase "beq_nat n 5 = true". reflexivity.
      SCase "beq_nat n 5 = false". reflexivity. Qed.


From CoqAlgs Require Export Base.
From CoqAlgs Require Export Ord.
From CoqAlgs Require Export EBTree.
From CoqAlgs Require Import DS.BST.RedBlack.

Class BalanceArgs (A : Ord) : Type :=
{
    B : Type;
    default : B;
    balance :
      forall (b : B) (l : EBTree B A) (v : A) (r : EBTree B A),
        EBTree B A;
    isEmpty_balance :
      forall (b : B) (l : EBTree B A) (v : A) (r : EBTree B A),
        isEmpty (balance b l v r) = false;
    Elem_balance :
      forall (b : B) (x v : A) (l r : EBTree B A),
        Elem x (balance b l v r) <-> Elem x l \/ x = v \/ Elem x r;
    isBST_balance :
      forall (b : B) (v : A) (l r : EBTree B A),
        isBST (N b l v r) -> isBST (balance b l v r);
}.

(* Coercion A : BalanceArgs >-> Ord. *)
(* Coercion A : BalanceArgs >-> Sortclass. *)

Definition BalancedBTree {A : Ord} (args : BalanceArgs A) : Type := EBTree B A.

Definition leaf
  {A : Ord} {args : BalanceArgs A}
  (x : A) : BalancedBTree args :=
    N default E x E.

Function insert
  {A : Ord} {args : BalanceArgs A}
  (x : A) (t : BalancedBTree args) : BalancedBTree args :=
match t with
    | E => N default E x E
    | N b l v r =>
        if x ≤? v
        then balance b (insert x l) v r
        else balance b l v (insert x r)
end.

Function removeMin
  {A : Ord} {args : BalanceArgs A}
  (t : BalancedBTree args)
    : option (A * BalancedBTree args) :=
match t with
    | E         => None
    | N b l v r =>
        match removeMin l with
            | None => Some (v, r)
            | Some (m, l') => Some (m, balance b l' v r)
        end
end.

Function remove
  {A : Ord} {args : BalanceArgs A}
  (x : A) (t : BalancedBTree args)
    : BalancedBTree args :=
match t with
    | E         => E
    | N b l v r =>
        match cmp x v with
            | Lt => balance b (remove x l) v r
            | Gt => balance b l v (remove x r)
            | Eq =>
                match removeMin r with
                    | None         => l
                    | Some (m, r') => balance b l m r'
                end
        end
end.

Fixpoint fromList
  {A : Ord} {args : BalanceArgs A}
  (l : list A) : BalancedBTree args :=
match l with
    | [] => E
    | h :: t => insert h (fromList t)
end.

(** Properties of [leaf]. *)

Lemma Elem_leaf :
  forall {A : Ord} {args : BalanceArgs A} (x y : A),
    Elem x (leaf y) <-> x = y.
Proof.
  unfold leaf. split.
    inv 1; inv H1.
    intros ->. auto.
Qed.

Lemma isBST_leaf :
  forall {A : Ord} {args : BalanceArgs A} (x : A),
    isBST (leaf x).
Proof.
  unfold leaf. intros. constructor; auto; inv 1.
Qed.

Lemma isBST2_leaf :
  forall {A : Ord} {args : BalanceArgs A} (x : A),
    isBST2 (leaf x).
Proof.
  constructor; auto.
Qed.

(** Properties of [insert]. *)

Lemma isEmpty_insert :
  forall
    {A : Ord} {args : BalanceArgs A}
    (x : A) (t : BalancedBTree args),
      isEmpty (insert x t) = false.
Proof.
  intros.
  functional induction insert x t;
  cbn.
    reflexivity.
    apply isEmpty_balance.
    apply isEmpty_balance.
Qed.

Lemma Elem_insert :
  forall
    {A : Ord} {args : BalanceArgs A}
    (x y : A) (t : BalancedBTree args),
      Elem x (insert y t) <-> x = y \/ Elem x t.
Proof.
  intros until t. revert x.
  functional induction insert y t;
  intros.
    split; inv 1.
    rewrite Elem_balance, IHb, Elem_N. split; firstorder.
    rewrite Elem_balance, IHb, Elem_N. split; firstorder.
Qed.

Lemma isBST_insert :
  forall
    {A : Ord} {args : BalanceArgs A}
    (x : A) (t : BalancedBTree args),
      isBST t -> isBST (insert x t).
Proof.
  intros until t.
  functional induction insert x t;
  inv 1.
    apply isBST_leaf.
    apply isBST_balance. constructor; auto.
      intros. rewrite Elem_insert in H. inv H. trich.
    apply isBST_balance. constructor; auto.
      intros. rewrite Elem_insert in H. inv H. trich.
Qed.

(* Lemma isBST2_insert :
  forall
    {A : Ord} {args : BalanceArgs A}
    (x : A) (t : BalancedBTree args),
      isBST2 t -> isBST2 (insert x t).
Proof.
  intros until t.
  functional induction insert x t;
  inv 1.
    apply isBST2_balance. constructor; auto.
      intros. rewrite Elem_insert in H. inv H. trich.
    apply isBST2_balance. constructor; auto.
      intros. rewrite Elem_insert in H. inv H. trich.
Qed.
 *)

(** * Properties of [removeMin]. *)

Lemma Elem_removeMin :
  forall
    {A : Ord} {args : BalanceArgs A}
    {t t' : BalancedBTree args} {m : A},
      removeMin t = Some (m, t') ->
        forall x : A, Elem x t <-> x = m \/ Elem x t'.
Proof.
  intros until t.
  functional induction removeMin t;
  inv 1; intro.
    functional inversion e0; subst.
      rewrite Elem_N. split; inv 1. inv H0. inv H.
    rewrite Elem_N, Elem_balance, (IHo _ _ e0).
      split; intro H; decompose [or] H; clear H; auto.
Qed.

Lemma isBST_removeMin :
  forall
    {A : Ord} {args : BalanceArgs A}
    (t t' : BalancedBTree args) (m : A),
      removeMin t = Some (m, t') ->
        isBST t -> isBST t'.
Proof.
  intros until t.
  functional induction removeMin t;
  inv 1; inv 1.
  {
    specialize (IHo _ _ e0 H5).
    apply isBST_balance.
    constructor; auto.
    intros. apply H4.
    rewrite (Elem_removeMin e0).
    right. assumption.
  }
Qed.

Lemma removeMin_spec :
  forall
    {A : Ord} {args : BalanceArgs A}
    {t t' : BalancedBTree args} {m : A},
      removeMin t = Some (m, t') ->
        isBST t -> forall x : A, Elem x t -> m ≤ x.
Proof.
  intros until t.
  functional induction removeMin t;
  inv 1; inv 1; intro x.
    functional inversion e0; subst. inv 1.
      trich.
      inv H1.
    inv 1.
      apply H4. rewrite (Elem_removeMin e0). auto.
      specialize (H4 _ H1). specialize (IHo _ _ e0 H5 _ H1). trich.
      specialize (H6 _ H1). assert (m0 ≤ v).
        apply H4. rewrite (Elem_removeMin e0). auto.
        trich.
Qed.

(** * Properties of [remove] *)

Lemma Elem_remove :
  forall
    {A : Ord} {args : BalanceArgs A}
    {t : BalancedBTree args} {x : A},
      isBST t ->
        forall y : A, Elem y (remove x t) -> Elem y t.
Proof.
  intros until x.
  functional induction remove x t;
  inv 1; intros y;
  rewrite Elem_balance, Elem_N.
    specialize (IHb H5 y). firstorder.
    specialize (IHb H7 y). firstorder.
    pose (Elem_removeMin e1 y). firstorder.
Qed.

Lemma isBST_remove :
  forall
    {A : Ord} {args : BalanceArgs A}
    (t : BalancedBTree args) (x : A),
      isBST t -> isBST (remove x t).
Proof.
  intros until x.
  functional induction remove x t;
  inv 1.
    apply isBST_balance. constructor; auto.
      intros. apply H4. eapply Elem_remove; eassumption.
    apply isBST_balance. constructor; auto.
      intros. apply H6. eapply Elem_remove; eassumption.
    apply isBST_balance. constructor; trich; intros.
      specialize (H4 _ H). assert (v ≤ m).
        apply H6. rewrite (Elem_removeMin e1). auto.
        trich.
      apply (removeMin_spec e1); auto. rewrite (Elem_removeMin e1). auto.
      eapply isBST_removeMin; eassumption.
Qed.

Module RB.

Import DS.BST.RedBlack.

#[refine]
#[export]
Instance BalanceArgs_Redblack (A : Ord) : BalanceArgs A :=
{
    B := color;
    default := Red;
    balance := balance;
}.
Proof.
  intros. apply isEmpty_balance.
  intros. apply Elem_balance.
  intros. apply isBST_balance. assumption.
Defined.

End RB.


From Coq Require Import List.
From Coq Require Import Arith.
From Coq Require Import Lia.
From PCC Require Import ssrexport.

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

Section ListUtils.

Variable A : Type.

Lemma app_cons_has_head : forall (a : A) l l', exists a', exists l'', l ++ a :: l' = a' :: l''.
Proof.
move => a; case => [l'|a' l l']; first by exists a; exists l'.
by exists a'; exists (l ++ a :: l').
Qed.

Lemma nil_or_app : forall l, l = nil \/ exists l', exists a: A, l = l' ++ a :: nil.
Proof.
elim => [|a l IHl]; first by left.
right; elim: IHl => H; first by exists nil; exists a; rewrite H.
by move: H => [l' [a' H]]; exists (a :: l'); exists a'; rewrite H.
Qed.

Lemma in_but_not_last : forall l (a b: A), In a (l ++ b :: nil) -> a = b \/ In a l.
Proof.
move => l a b H.
apply In_rev in H.
rewrite distr_rev /= in H.
by elim: H => H; [ left | right; apply In_rev in H ].
Qed.

Lemma list_rearrange : forall l l' (a:A), l ++ a :: l' = (l ++ a :: nil) ++ l'.
Proof. by elim => [|a l IH l' a']; [ case | rewrite app_ass ]. Qed.

Lemma list_rearrange2 : forall l (a b: A), l ++ a :: b :: nil = (l ++ a :: nil) ++ b :: nil.
Proof. by move => l a b; rewrite app_ass. Qed.

Lemma list_rearrange3 : forall l l' (a : A), (a :: l) ++ l' = a :: l ++ l'.
Proof. by []. Qed.

Lemma list_neq_length : forall l l': list A, length l <> length l' -> l <> l'.
Proof. by move => l l' H; contradict H; rewrite H. Qed.

Inductive prefix : list A -> list A -> Prop :=
| prefix_nil : forall l, prefix nil l
| prefix_next : forall (a: A) l l', prefix l l' -> prefix (a :: l) (a :: l').

Lemma prefix_firstn : forall n (l : list A), n <= length l -> prefix (firstn n l) l.
Proof.
elim => [l H|n IHn]; first by apply prefix_nil.
case => [|a l] H; first by inversion H.
by apply prefix_next; apply IHn; apply le_S_n.
Qed.

Inductive proper_prefix : list A -> list A -> Prop :=
| proper_prefix_nil : forall (l: list A) a, proper_prefix nil (a :: l)
| proper_prefix_next : forall a l l', proper_prefix l l' -> proper_prefix (a :: l) (a :: l').

Lemma proper_prefix_app : forall (l l' l'': list A),
  proper_prefix l l' -> proper_prefix (l'' ++ l) (l'' ++ l').
Proof.
move => l l'.
elim => [|a l'' IH H]; first by [].
rewrite -2!app_comm_cons.
by apply proper_prefix_next; apply IH.
Qed.

Lemma proper_prefix_last : forall l (a: A), proper_prefix l (l ++ a :: nil).
Proof.
elim => [|a l IH a']; first by apply proper_prefix_nil.
by rewrite -app_comm_cons; apply proper_prefix_next.
Qed.

Lemma proper_prefix_split : forall (l l': list A),
  proper_prefix l' l -> exists x, exists l'', l = l' ++ (x :: l'').
Proof.
elim => [l' H|a l IH]; first by inversion H.
case => [|a' l'] H; first by exists a; exists l.
have ->: a = a' by inversion H.
have H0: proper_prefix l' l by inversion H.
apply IH in H0.
move: H0 => [x [l'' H0]].
by exists x; exists l''; rewrite H0.
Qed.

Lemma proper_prefix_shorter : forall (l' l: list A), proper_prefix l' l -> length l' < length l.
Proof.
move => l' l H.
apply proper_prefix_split in H.
move: H => [a' [l'' H]].
rewrite H app_length /=.
by lia.
Qed.

Theorem proper_prefix_well_founded : well_founded (@proper_prefix).
Proof.
apply well_founded_lt_compat with (f := @length A).
by apply proper_prefix_shorter.
Qed.

Theorem strong_list_ind (P: list A -> Prop) :
  (forall l, (forall l', proper_prefix l' l -> P l') -> P l) -> forall l, P l.
Proof.
move => H.
apply well_founded_ind with (R := @proper_prefix).
apply proper_prefix_well_founded.
move => x H0.
apply H => l' H1.
by apply H0.
Qed.

Lemma in_list_in_prefix : forall l l' (a: A), proper_prefix l' l -> In a l' -> In a l.
Proof.
move => l l' a H H0.
apply proper_prefix_split in H.
move: H => [a' [l'' H]].
rewrite H.
by apply in_or_app; left.
Qed.

Lemma nil_or_last : forall l, l = nil \/ exists l', exists a : A, l = l' ++ a :: nil.
Proof. by elim/rev_ind => [|a l IH]; [ left | right; exists l; exists a ]. Qed.

Inductive suffix : list A -> list A -> Prop :=
| suffix_here : forall (l: list A), suffix l l
| suffix_next : forall a suffx l, suffix suffx l -> suffix suffx (a::l).

Lemma suffix_split : forall l suffx: list A,
  suffix suffx l -> exists pref, l = pref ++ suffx.
Proof.
elim => [|a l IH] suffx H; first by inversion H; exists nil.
inversion H; subst; first by exists nil.
apply IH in H2.
move: H2 => [l' H2].
by exists (a :: l'); rewrite H2.
Qed.

Lemma suffix_app : forall l l' l'': list A,
  suffix l l' -> suffix l (l'' ++ l').
Proof.
move => l l'.
elim => [|a l'' IH H]; first by [].
rewrite /=;
by apply suffix_next; apply IH.
Qed.

Lemma suffix_transitive : forall c bc abc: list A,
  suffix bc abc -> suffix c bc -> suffix c abc.
Proof.
move => c bc abc H H0.
apply suffix_split in H.
apply suffix_split in H0.
move: H => [pref H]; move: H0 => [pref' H0].
rewrite H H0.
by do 2!apply suffix_app; apply suffix_here.
Qed.

Inductive last : list A -> A -> Prop :=
| last_base : forall a, last (a :: nil) a
| last_cons : forall l a b, last l a -> last (b::l) a.

Lemma last_exists : forall l (c : A), exists c', last (c :: l) c'.
Proof.
elim => [|a l IH] c; first by exists c; apply last_base.
have H: exists c', last (c :: l) c' by apply IH.
move: H => [c' H] {IH}.
inversion H; first by exists a; apply last_cons; apply last_base.
by exists c'; apply last_cons; apply last_cons.
Qed.

Lemma single_last : forall l (a b: A), last l a -> last l b -> a = b.
Proof.
elim => [|a' l IH] a b H H0; first by inversion H.
inversion H; subst; first by inversion H0; subst; last by inversion H4.
apply IH; first by [].
by inversion H0; subst; first by inversion H4.
Qed.

Lemma last_app : forall l l' (a: A), last l' a -> last (l++l') a.
Proof.
elim => [|a' l IH l' a H]; first by [].
by apply last_cons; apply IH.
Qed.

Lemma app_last : forall l (a: A), last (l ++ a :: nil) a.
Proof.
elim => [|a' l IH] a; first by apply last_base.
by rewrite list_rearrange3; apply last_cons.
Qed.

Lemma last_app_prefix : forall (l : list A) (a : A),
  last l a -> exists l', l = l' ++ a::nil.
Proof.
elim => [|a' l IH] a H; first by inversion H.
inversion H; subst; first by exists nil.
apply IH in H3.
move: H3 => [l'' H3]; rewrite H3 {H3}.
by exists (a' :: l'').
Qed.

Lemma last_app_cons :forall l (a b: A), last (l ++ a::nil) b -> a = b.
Proof.
move => l a b H.
apply last_app_prefix in H.
move: H => [l' H].
apply app_inj_tail in H.
by move: H => [H H0].
Qed.

Lemma list_same_head : forall l (a b: A),
  head (l ++ a :: nil) = head (l ++ a :: b :: nil).
Proof. by case. Qed.

End ListUtils.


Require Import List.
Require Import String.

(* Printing function *)

Fixpoint is_eq (n m: nat) {struct n} :=
 match n, m with
  0, 0 => true | (S n1), (S m1) => is_eq n1 m1 | _ ,_ => false end.

Fixpoint adiv (n m p: nat) {struct p} :=
  match p with 0 => false | (S p1) =>
    if (is_eq n m) then true else adiv (n - m) m p1
  end.

Definition div n m :=
match m with 0 => true | _ => adiv m n m end.

Fixpoint print_line (n m: nat) (l: list nat) {struct n}:
  string * list nat :=
let v := if (div m n) then "|"%string else ""%string in
match n, l with
    O  ,    _ => (v, l)
|  (S n1), (0 :: l1) =>
    let (s1, l2) := print_line n1 m l1 in
                 (append v (append " " s1),
                  l2)
|  (S n1), (n :: l1) =>
    let (s1, l2) := print_line n1 m l1 in
                 (append v
                  (String (Ascii.ascii_of_nat (n + 48)) s1),
                  l2)
| _,_ => ("error"%string , l)
end.

Fixpoint paux (m n p q: nat) (s: string) (l: list nat) {struct m}:
  string :=
let v := if (div p m) then s else ""%string in
append v
match m with
    O      => ""%string
|  (S m1)  =>
    let (s1, l1) := print_line n q l in
      append s1 (String (Ascii.ascii_of_nat 10) (paux m1 n p q s l1))
end.

Fixpoint print_sep (n: nat): string :=
  match n with 0 => ""%string | S n1 => append "-" (print_sep n1) end.

Definition print n m s :=
  let lf := Ascii.ascii_of_nat 10 in
  let nm := n * m in
  let s1 := (append
               (print_sep (1 + n + nm))
               (String lf ""%string))
 in
  String lf (paux nm nm n m s1 s).


Require Import LibTactics.
Require Import Metalib.Metatheory.

Require Import
        syntax_ott
        rules_inf
        Infrastructure
        Subtyping_inversion
        Key_Properties
        rules_inf2
        dunfield.

Require Import Omega.

Lemma open_dexp_eqn_aux :
                forall ee1 ee2 x n,
       x `notin` fv_dexp ee1 ->
       x `notin` fv_dexp ee2 ->
       open_dexp_wrt_dexp_rec n (de_var_f x) ee1 = open_dexp_wrt_dexp_rec n (de_var_f x) ee2
       -> ee1 = ee2.
Proof.
  apply_mutual_ind dexp_mutind;
  apply_mutual_ind dexp_mutind;
  default_simp;
  try solve [eapply_first_hyp; eauto].
  omega.
Qed.

Lemma open_dexp_eqn : forall x ee1 ee2,
       x `notin` fv_dexp ee1 ->
       x `notin` fv_dexp ee2 ->
       open_dexp_wrt_dexp ee1 (de_var_f x) = open_dexp_wrt_dexp ee2 (de_var_f x)
       -> ee1 = ee2.
Proof.
  intros x ee1 ee2 H H0 H1.
  unfold open_dexp_wrt_dexp in H1.
  pose proof open_dexp_eqn_aux.
  eauto.
Qed.

Lemma subtyping_completeness : forall A B,
    isub A B -> sub A B.
Proof.
  intros A B H.
  induction* H.
Qed.

Lemma disjoint_completeness : forall A B,
    icfpDisjoint A B -> disjointSpec A B.
Proof.
  intros A B H. apply disjoint_eqv.
  induction~ H.
  (* H: icfpDisjointAx A B *)
  induction~ H.
  (* symm case *)
  apply disjoint_eqv.
  applys~ disjoint_symmetric.
  apply~ disjoint_eqv.
Qed.

(* completeness of typing with respect to the type system in ICFP 2016 *)
Theorem typing_completeness : forall G ee A e,
    ITyping G ee A e -> Etyping G e A /\ |e| = ee.
Proof with auto.
  intros G ee A e Typ.
  induction Typ...
  -
    split.
    eapply Etyp_abs.
    intros.
    forwards* [? ?]: H1 H2.
    auto_sub.
    auto_sub.
    simpl.
    pick fresh x for (union L (union (fv_dexp (|e|)) (fv_dexp ee))).
    forwards* [? ?]: H1.
    rewrite erasure_open in H3.
    simpl in H3.
    forwards*: open_dexp_eqn H3.
    congruence.
  -
    lets [HT1 Era1]: IHTyp1.
    lets [HT2 Era2]: IHTyp2.
    split*.
    simpl.
    congruence.
  -
    apply disjoint_completeness in H.
    lets [HT1 Era1]: IHTyp1.
    lets [HT2 Era2]: IHTyp2.
    simpl.
    split...
    congruence.
  -
    destruct IHTyp.
    apply subtyping_completeness in H.
    split*.
Qed.


(******************************************************************************
September 2004
Authors: Jean-Yves Vion-dury and Pierre Geneves

jean-yves.vion-dury@xrce.xerox.com
WAM Research Project, INRIA Rhone-Alpes and Xerox Research Center Europe

pierre.geneves@inrialpes.fr
WAM Research Project, INRIA Rhone-Alpes

Please do not reuse or publish this code without explicit consent from authors.
*******************************************************************************)
Require Import ZArith.
Require Import setOrder.
Require Import Bool.

Module Type genSetsInt.

Parameter A : Set.
Parameter A_le : A -> A -> bool.
Parameter A_lt : A -> A -> bool.
Parameter A_eq : A -> A -> bool.
(*
Parameter set:Set.
Parameter empty:set.
Parameter item:A->set->set.
*)
Inductive set : Set :=
  | empty : set
  | item : A -> set -> set.
Parameter single : A -> set.
Parameter s_in : A -> set -> bool.
Parameter cat : set -> set -> set.
Parameter wf : set -> bool.
Parameter card : set -> Z.

Parameter add : A -> set -> set.
Parameter sub : A -> set -> set.

Parameter reduce : forall B : Set, (B -> A -> B) -> B -> set -> B.

Parameter union : set -> set -> set.
Parameter inter : set -> set -> set.
Parameter diff : set -> set -> set.

Parameter incl : set -> set -> bool.
Parameter s_eq : set -> set -> bool.

Parameter product : set -> (A -> set) -> set.
Parameter filter : set -> (A -> bool) -> set.

Axiom not_single_empty : forall x : A, single x <> empty.

Axiom
  wf_cat :
    forall s1 s2 : set,
    wf s1 = true ->
    wf s2 = true ->
    forall (s11 s22 : set) (a b : A),
    s1 = cat s11 (item a empty) ->
    s2 = item b s22 -> A_lt a b = true -> wf (cat s1 s2) = true.

Axiom
  cat_incl :
    forall s1 s2 : set,
    wf (cat s1 s2) = true ->
    forall a : A,
    (s_in a s1 = true -> s_in a s2 = false) /\
    (s_in a s2 = true -> s_in a s1 = false).
Axiom
  cat_union :
    forall s1 s2 : set, wf (cat s1 s2) = true -> cat s1 s2 = union s1 s2.
Axiom
  cat_inter :
    forall s1 s2 : set, wf (cat s1 s2) = true -> inter s1 s2 = empty.

Axiom in_sem1 : forall a : A, s_in a empty = false.
Axiom in_sem2 : forall (a : A) (s : set), s_in a (item a s) = true.
Axiom
  in_sem3 :
    forall (a : A) (s : set),
    wf s = true ->
    s_in a s = true ->
    exists s1 : set, (exists s2 : set, s = cat s1 (item a s2)).
Axiom
  in_sem4 :
    forall (a : A) (s1 s2 : set),
    wf (cat s1 s2) = true ->
    s_in a (cat s1 s2) = true -> s_in a s1 = true \/ s_in a s2 = true.

Axiom in_sem5 : forall (a b : A) (s : set),
s_in a s = true -> s_in a (item b s) = true.

Axiom in_sem6 : forall (a b : A) (s : set),
s_in a (item b s) = true -> ~a=b -> s_in a s = true.

Axiom
  in_Lunion :
    forall (a : A) (s1 s2 : set),
     s_in a (union s1 s2) = true -> s_in a s2 = false ->
     s_in a s1 = true.

Axiom
  in_unionL :
    forall (a : A) (s s2 : set),
    s_in a s = true -> s_in a (union s s2) = true.

Axiom
  in_unionR :
    forall (a : A) (s s2 : set),
    s_in a s = true -> s_in a (union s2 s) = true.

Axiom in_union: forall (a b : set)(y : A),
(s_in y (union a b)=true)
->((s_in y a=true) \/ (s_in y b=true)).

Axiom in_inter1: forall (a b :set) (y : A),
 (s_in y (inter a b)=true)->
((s_in y a=true) /\ (s_in y b=true)).

Axiom in_inter2: forall (a b : set) (y : A),
((s_in y a=true) /\ (s_in y b=true)) ->
(s_in y (inter a b)=true).

Axiom single_sem : forall x : A, s_in x (single x) = true.
Axiom in_single : forall x y : A, s_in x (single y) = true -> x=y.

Axiom
  in_dec : forall (s : set) (a : A), {s_in a s = true} + {s_in a s = false}.

Axiom wf_emb : forall (a : A) (s : set), wf (item a s) = true -> wf s = true.
Axiom
  wf_in_lt :
    forall (a : A) (s : set),
    wf (item a s) = true -> forall b : A, s_in b s = true -> A_lt a b = true.
Axiom
  in_embedded :
    forall (a b : A) (s : set), s_in a s = true -> s_in a (item b s) = true.

(* ----- cardinal ---- *)
Axiom card_is_pos : forall s : set, (0 <= card s)%Z.
Axiom card_empty : card empty = 0%Z.

(* ----- add ------- *)
Axiom add_sem1 : forall (a : A) (s : set), s_in a s = true -> add a s = s.
Axiom add_sem2 : forall (a : A) (s : set), s_in a (add a s) = true.
Axiom
  in_add :
    forall (a : A) (s : set),
    s_in a s = true -> forall b : A, s_in a (add b s) = true.
Axiom add_wf : forall (a : A) (s : set), wf s = true -> wf (add a s) = true.
Axiom
  add_card1 :
    forall (a : A) (s : set),
    s_in a s = false -> card (add a s) = (card s + 1)%Z.
Axiom add_card2 : forall (a : A) (s : set), (card (add a s) >= card s)%Z.

(* ----- sub ------- *)
Axiom sub_sem1 : forall (a : A) (s : set), s_in a s = false -> sub a s = s.
Axiom sub_sem2 : forall (a : A) (s : set), s_in a (sub a s) = false.
Axiom sub_wf : forall (a : A) (s : set), wf s = true -> wf (sub a s) = true.
Axiom
  sub_card1 :
    forall (a : A) (s : set),
    s_in a s = true -> card (sub a s) = (card s - 1)%Z.
Axiom sub_card2 : forall (a : A) (s : set), (card (sub a s) <= card s)%Z.

Axiom sub_add_sem : forall (a : A) (s : set), sub a (add a s) = s.

(* ----- union ------- *)
Axiom
  union_semL :
    forall (a : A) (s1 s2 : set),
    s_in a s1 = true -> s_in a (union s1 s2) = true.
Axiom
  union_semR :
    forall (a : A) (s1 s2 : set),
    s_in a s2 = true -> s_in a (union s1 s2) = true.

Axiom incl_unionR : forall s1 s2 : set, incl s2 (union s1 s2) = true.
Axiom incl_unionL : forall s1 s2 : set, incl s1 (union s1 s2) = true.
Axiom
  incl_incl_unionR :
    forall s s1 s2 : set, incl s s2 = true -> incl s (union s1 s2) = true.
Axiom
  incl_incl_unionL :
    forall s s1 s2 : set, incl s s2 = true -> incl s (union s2 s1) = true.

Axiom union_incl : forall s1 s2 : set, incl s1 s2 = true -> union s1 s2 = s2.
Axiom union_empty : forall s : set, union s empty = s.
Axiom union_empty2 : forall s : set, union empty s = s.
Axiom union_idem : forall s : set, union s s = s.
Axiom union_sym : forall s1 s2 : set, union s1 s2 = union s2 s1.
Axiom
  union_assoc :
    forall s1 s2 s3 : set, union s1 (union s2 s3) = union (union s1 s2) s3.

Axiom
  wf_union :
    forall s1 s2 : set,
    wf s1 = true -> wf s2 = true -> wf (union s1 s2) = true.
Axiom
  card_union :
    forall s1 s2 : set, (card (union s1 s2) <= card s1 + card s2)%Z.

(* ----- inter ------- *)
Axiom
  inter_semL :
    forall (a : A) (s1 s2 : set),
    s_in a s1 = true -> s_in a s2 = true -> s_in a (inter s1 s2) = true.
Axiom inter_empty : forall s : set, inter s empty = empty.
Axiom inter_incl : forall s1 s2 : set, incl s1 s2 = true -> inter s1 s2 = s1.
Axiom inter_idem : forall s : set, inter s s = s.
Axiom inter_sym : forall s1 s2 : set, inter s1 s2 = inter s2 s1.
Axiom
  inter_assoc :
    forall s1 s2 s3 : set, inter s1 (inter s2 s3) = inter (inter s1 s2) s3.

Axiom
  wf_inter :
    forall s1 s2 : set,
    wf s1 = true -> wf s2 = true -> wf (inter s1 s2) = true.
Axiom card_interL : forall s1 s2 : set, (card (inter s1 s2) <= card s1)%Z.
Axiom card_interR : forall s1 s2 : set, (card (inter s1 s2) <= card s2)%Z.

(* ----- diff ------- *)
Axiom
  inter_sem :
    forall (a : A) (s1 s2 : set),
    s_in a s2 = true -> s_in a (diff s1 s2) = false.
Axiom diff_empty : forall s : set, diff s empty = s.
Axiom diff_diff : forall s : set, diff s s = empty.
Axiom diff_inter : forall s1 s2 : set, diff s1 s2 = diff s1 (inter s1 s2).
Axiom
  diff_inter_empty :
    forall s1 s2 : set, inter s1 s2 = empty -> diff s1 s2 = s1.
Axiom
  wf_diff :
    forall s1 s2 : set,
    wf s1 = true -> wf s2 = true -> wf (diff s1 s2) = true.
Axiom card_diff : forall s1 s2 : set, (card (diff s1 s2) <= card s1)%Z.

(* ---- mixing operators ---- *)
(*
Axiom inter_union: (s1,s2:set) (inter s1 (union s2 s3))=(union (inter s1 s2) (inter s1 s3)).
Axiom inter_diff: (s1,s2:set) (inter s1 (diff s2 s3))=(diff (inter s1 s2) s3).

Axiom union_inter: (s1,s2:set) (union s1 (inter s2 s3))=(inter (union s1 s2) (union s1 s3)).
Axiom union_diff: (s1,s2:set) (union s1 (diff s2 s3))=(union (diff (union s1 s2) s3) (diff (inter s1 s3) s2)).

Axiom diff_union1: (s1,s2:set) (diff s1 (union s2 s3))=(union (diff s1 s2) (diff s1 s3)).
Axiom diff_union2: (s1,s2:set) (diff s1 (union s2 s3))=(diff (diff s1 s2) s3).
Axiom diff_inter: (s1,s2:set) (diff s1 (inter s2 s3))=(inter (diff s1 s2) (diff s1 s3)).

All: To be checked !

*)

(* ---- inclusion ---- *)
Axiom
  in_incl :
    forall s1 s2 : set,
    (forall a : A, s_in a s1 = true -> s_in a s2 = true) <->
    incl s1 s2 = true.

Axiom incl_empty : forall s : set, incl empty s = true.
Axiom incl_empty_not : forall s : set, s <> empty -> incl s empty = false.

(* ---- equality ---- *)
Axiom
  s_eq_sem : forall s1 s2 : set, s_eq s1 s2 = andb (incl s1 s2) (incl s2 s1).
Axiom
  s_eq_eq :
    forall s1 s2 : set,
    wf s1 = true -> wf s2 = true -> (s1 = s2 <-> s_eq s1 s2 = true).
Axiom
  s_neq_neq :
    forall s1 s2 : set,
    wf s1 = true -> wf s2 = true -> (s1 <> s2 <-> s_eq s1 s2 = false).

  Axiom
    s_eq_dec : forall s1 s2 : set, {s_eq s1 s2 = true} + {s_eq s1 s2 = false}.
  Axiom s_eq_struct : forall s1 s2 : set, s_eq s1 s2 = true -> s1 = s2.
  Axiom s_eq_reflexive : forall s : set, s_eq s s = true.
  Axiom
    s_eq_symmetric :
      forall s1 s2 : set, s_eq s1 s2 = true -> s_eq s2 s1 = true.
  Axiom
    s_eq_transitive :
      forall s1 s2 s3 : set,
      s_eq s1 s2 = true -> s_eq s2 s3 = true -> s_eq s1 s3 = true.

(* ---- product ---- *)
Axiom
  product_sem :
    forall (f : A -> set) (a : A) (s : set),
    s_in a s = true -> incl (f a) (product s f) = true.
Axiom
  wf_product :
    forall (f : A -> set) (s : set),
    wf s = true -> (forall a : A, wf (f a) = true) -> wf (product s f) = true.

Axiom
  product_single : forall (f : A -> set) (a : A), product (single a) f = f a.

Axiom product_sem2 :
 forall (f : A -> set) (a : A) (s : set),
 (product (item a s) f) = union (f a) (product s f).

Axiom
  product_unionL :
    forall (f : A -> set) (s1 s2 : set),
    product (union s1 s2) f = union (product s1 f) (product s2 f).

Axiom
  product_unionR :
    forall (f1 f2 : A -> set) (s : set),
    product s (fun x : A => union (f1 x) (f2 x)) =
    union (product s f1) (product s f2).

Axiom product_empty : forall f : A -> set, product empty f = empty.

Axiom product_empty2 : forall s : set, product s (fun a : A => empty) = empty.

Axiom product_add :
 forall (f : A -> set) (a : A) (s : set),
 product (add a s) f = union (f a) (product s f).

(* ---- filter ---- *)
Axiom
  filter_sem1 :
    forall (f : A -> bool) (s : set) (a : A),
    s_in a s = true -> f a = true -> s_in a (filter s f) = true.
Axiom
  filter_sem2 :
    forall (f : A -> bool) (s : set) (a : A),
    s_in a s = true -> f a = false -> s_in a (filter s f) = false.

Axiom filter_sem3:
    forall (f : A -> bool),
    filter empty f = empty.

Axiom filter_sem4:
    forall (f : A -> bool) (s : set) (a : A),
    filter (item a s) f = if (f a) then (item a (filter s f)) else (filter s f).

Axiom filter_sem5:
    forall (f : A -> bool) (s : set) (a : A),
    (f a=true)->s_in a (filter (item a s) f) = true.

Axiom filter_sem6:
    forall (f : A -> bool) (s : set) (a : A),
    (f a=false)->s_in a (filter (item a s) f) = false.

Axiom
  wf_filter :
    forall (f : A -> bool) (s : set), wf s = true -> wf (filter s f) = true.

(*
Axiom incl_sem: (x,y:set) ( (a:A)(s_in a x)=true -> (s_in a y)=true ) -> (incl x y)=true.

Axiom product_sem2:
	(f:A->set ; s:set; x:A)
	(s_in x s)=true -> (product s f)= (union (f x) (product (sub x s) f)
	.
Axiom product_sem4:
	(f:A->set ; s:set)
	s=empty -> (product s f)=empty
	.
*)

Section reflexiveSets.
Axiom incl_dec : forall x y : set, {incl x y = true} + {incl x y = false}.
Axiom incl_reflexive : forall x : set, incl x x = true.

(* wrong *)
(*Axiom incl_asymmetric:(x,y:set)(incl x y)=false -> (incl y x)=true.*)

Axiom
  incl_antisymmetric :
    forall x y : set, incl x y = true -> incl y x = true -> x = y.
Axiom
  incl_transitive :
    forall (b : bool) (x y z : set),
    incl x y = b -> incl y z = b -> incl x z = b.
End reflexiveSets.

End genSetsInt.


Require Import Prelude.
Require Import Lambda.

Require Import Recdef.

Set Bullet Behavior "Strict Subproofs".

Definition isVal (e : Expr) : Prop :=
  match e with
    | Var _ => True
    | Lam _ _ => True
    | _ => False
  end.

Definition rename : Name -> Name -> Expr -> Expr :=
  fix rename v w body
        := match body with
             | Var v' => Var (if v == v' then w else v')
             | Lam v' e => Lam v' (if v == v' then e else rename v w e)
             | App e1 e2 => App (rename v w e1) (rename v w e2)
             | Let v' rhs body => Let v' (rename v w rhs) (if v == v'
                                                          then body
                                                          else rename v w body)
           end.

Fixpoint depth e : nat := match e with
  | Var v' => 0
  | Lam v' e => S (depth e)
  | App e1 e2 =>
    Nat.max (S (depth e1)) (S (depth e2))
  | Let v' rhs body =>
    Nat.max (S (depth rhs)) (S (depth body))
end.

Lemma depth_rename : forall v w e,
    depth (rename v w e) = depth e.
Proof.
  intros.
  induction e.
  * auto.
  * simpl.
    destruct (v == n).
    + rewrite IHe1. auto.
    + rewrite IHe1. rewrite IHe2. auto.
  * simpl.
    destruct (v == n).
    + auto.
    + rewrite IHe. auto.
  * simpl.
    rewrite IHe1. rewrite IHe2.
    auto.
Qed.

Function subst v arg body {measure depth body} :=
  match body with
  | Var v' => if v == v' then arg else Var v'
  | Lam v' e => if v == v' then Lam v' e else
                    let f := fresh e in
                    Lam f (subst v arg (rename v' v e))
  | App e1 e2 => App (subst v arg e1)  (subst v arg e2)
  | Let v' rhs body =>
    let v'' := fresh body in
    let rhs' := subst v arg rhs in
    let body' := subst v arg (rename v' v'' body) in
    Let v' rhs' body'
  end.
Proof.
  all: intros; simpl;
    repeat rewrite depth_rename; zify; omega.
Qed.

Inductive small_step : Expr -> Expr -> Prop :=
| ss_beta : forall v body arg,
    isVal arg ->
    small_step (App (Lam v body) arg) (subst v arg body)
| ss_let: forall v body rhs ,
    isVal rhs ->
    small_step (Let v rhs body) (subst v rhs body)
| ss_let_search: forall v body rhs rhs',
    small_step rhs rhs' ->
    small_step (Let v rhs body) (Let v rhs' body)
| ss_app_search : forall m m' n,
    small_step m m' ->
    small_step (App m n) (App m' n)
| ss_app_val: forall m n n',
    isVal m ->
    small_step n n' ->
    small_step (App m n) (App m n').

Fixpoint small_step_fun (t : Expr) : option Expr :=
  match t with
  | App t1 t2 => match t1 with
                | Lam v t3 =>
                  match small_step_fun t2 with
                  | Some t2' => Some (App t1 t2')
                  | _ => match t2 with
                        | App _ _ => None
                        | Let _ _ _ => None
                        | _ => Some (subst v t2 t3)
                        end
                  end
                | Var i =>
                  match small_step_fun t2 with
                    | Some t2' => Some (App t1 t2')
                    | _ => None
                    end
                | _ => match (small_step_fun t1) with
                      | Some t1' => Some (App t1' t2)
                      | _ => None
                      end
                   end
  | Let v t1 t2 =>
    match t1 with
      | Var _ => Some (subst v t1 t2)
      | Lam _ _ => Some (subst v t1 t2)
      | _ => match (small_step_fun t1) with
            | Some t1' => Some (Let v t1' t2)
            | _ => None
            end
    end
  | _ => None
  end.

Lemma isVal_not_step: forall n,
    isVal n -> small_step_fun n = None.
Proof.
  intros []; auto;
  intros H; inversion H.
Qed.

Lemma fun_step : forall  k m m', (k = depth m)%nat ->
  small_step_fun m = Some m' -> small_step m m'.
Proof.
  intro k.
  induction (lt_wf k) as [n _ IH].
  intros m m' Heq SS.
  destruct m; simpl in *; subst; try solve [inversion SS].
  - (* let *)
    destruct m1.
    + inversion SS.
      eapply ss_let; simpl; auto.
    + destruct (small_step_fun (Let n m1_1 m1_2)) eqn:J; inversion SS.
      eapply ss_let_search.
      eapply (IH (depth (Let n m1_1 m1_2))); auto.
      zify; omega.
    + inversion SS.
      eapply ss_let; simpl; auto.
    + destruct (small_step_fun (App m1_1 m1_2)) eqn:J; inversion SS.
      eapply ss_let_search.
      eapply (IH (depth (App m1_1 m1_2))); auto.
      zify; omega.
  -  (* app *)
    destruct m1.
    + destruct (small_step_fun m2) eqn:J; inversion SS.
      eapply ss_app_val.
      simpl; auto.
      eapply (IH (depth m2)); simpl; auto.
    + destruct (small_step_fun (Let n m1_1 m1_2)) eqn:J; inversion SS.
      eapply ss_app_search.
      eapply (IH (depth (Let n m1_1 m1_2))); auto.
      zify; omega.
    + destruct (small_step_fun m2) eqn:J; inversion SS.
      eapply ss_app_val.
      simpl; auto.
      eapply (IH (depth m2)); auto.
      zify; omega.
      destruct m2;
        try solve [inversion SS; eapply ss_beta; simpl; auto].
    + destruct (small_step_fun (App m1_1 m1_2)) eqn:J; inversion SS.
      eapply ss_app_search.
      eapply (IH (depth (App m1_1 m1_2))); auto.
      zify; omega.
Qed.

Lemma small_step_small_step_fun : forall m m',
  small_step m m' <-> small_step_fun m = Some m'.
Proof.
  split.
  - induction 1; simpl.
    + (* beta *) rewrite isVal_not_step; auto.
      destruct arg; auto; inversion H.
    + (* let *) destruct rhs; auto;
        inversion H; subst.
    + (* let search *) destruct rhs; auto; try solve [inversion H];
        rewrite IHsmall_step; auto.
    + (* app search *)
      destruct m; try solve [inversion IHsmall_step];
      rewrite IHsmall_step; auto.
    + (* app val *)
      destruct m; try solve [inversion H];
      rewrite IHsmall_step; auto.
  - eapply fun_step. eauto.
Qed.

Inductive rtc {A} (R:A -> A -> Prop) : A -> A -> Prop :=
| rtc_refl : forall a, rtc R a a
| rtc_step : forall a b c, R a b -> rtc R b c -> rtc R a c.

Notation "R ^*" := (rtc R) (at level 1, format "R ^*").

Definition nf (x: Expr): Prop := ~ exists y, small_step x y.

(*
Inductive beta_equiv : Expr -> Expr -> Prop :=
| be_refl: forall x, beta_equiv x y
| be_Step: forall v x y,
    beta_equiv (Let v x y) (App (Lam v y) x)

| be_Var : forall v, beta_equiv (Var v) (Var v)
| be_Let: forall v x1 x2 y1 y2,
    beta_equiv x1 x2 -> beta_equiv y1 y2 ->
    beta_equiv (Let v x1 y1) (Let v x2 y2)
| be_App: forall x1 x2 y1 y2,
    beta_equiv x1 x2 -> beta_equiv y1 y2 ->
    beta_equiv (App x1 y1) (App x2 y2)
| be_Lam: forall v x1 x2,
    beta_equiv x1 x2 ->
    beta_equiv (Lam v x1) (Lam v x2).

| ss_beta : forall v body arg,
    isVal arg ->
    small_step (App (Lam v body) arg) (subst v arg body)
| ss_let: forall v body rhs ,
    isVal rhs ->
    small_step (Let v rhs body) (subst v rhs body)
*)
(*
Let x y z ==  App (Lam x z)  y

    Lam x (App x (Lam y y)) is nf
anf (Lam x (App x (Lam y y))) =
     Lam x (Let z = (Lam y y) in x z)
*)
(*
Theorem anf_correct: forall x y,
    small_step^* x y -> nf y ->
    small_step^* (anf x) y' /\ R y y'.
Proof.
  intros x y Hs Hn.
*)


Require Export GeoCoq.Elements.OriginalProofs.euclidean_defs.
Require Export GeoCoq.Elements.OriginalProofs.euclidean_tactics.

Section Euclid.

Context `{Ax:euclidean_neutral_ruler_compass}.

Lemma lemma_localextension :
   forall A B Q,
   neq A B -> neq B Q ->
   exists X, BetS A B X /\ Cong B X B Q.
Proof.
intros.
assert (eq B B) by (conclude cn_equalityreflexive).
let Tf:=fresh in
assert (Tf:exists J, CI J B B Q) by (conclude postulate_Euclid3);destruct Tf as [J];spliter.
assert (InCirc B J) by (conclude_def InCirc ).
let Tf:=fresh in
assert (Tf:exists C E, (Col A B C /\ BetS A B E /\ OnCirc C J /\ OnCirc E J /\ BetS C B E)) by (conclude postulate_line_circle);destruct Tf as [C[E]];spliter.
assert (Cong B E B Q) by (conclude axiom_circle_center_radius).
close.
Unshelve.
exact A.
exact A.
Qed.

End Euclid.


Lemma sum_0 : forall (n m:nat), n + m = 0 -> n = 0 /\ m = 0.
Proof.
    intros [|n] [|m].
    - intros _. split; reflexivity.
    - intros H. inversion H.
    - intros H. inversion H.
    - intros H. inversion H.
Qed.


Require Import Arith.

Set Implicit Arguments.

Fixpoint ack n :=
  match n with
    | 0 => S
    | S n' =>
      let fix f m :=
        match m with
          | 0 => ack n' 1
          | S m' => ack n' (f m')
        end
        in f
  end.

Fixpoint fin n : Set :=
  match n with
    | 0 => Empty_set
    | S n' => (unit + fin n')%type
  end.

Inductive prim_rec : nat -> Set :=
| pr_proj : forall n, fin n -> prim_rec n
| pr_succ : prim_rec 1
| pr_const : forall n, nat -> prim_rec n
| pr_compose :
  forall m n, (fin n -> prim_rec m) -> prim_rec n -> prim_rec m
| pr_primrec :
  forall n, prim_rec n -> prim_rec (S (S n)) -> prim_rec (S n).

Notation F0 := (inl _ tt).
Notation FS x := (inr _ x).

Definition hd n (ns : fin (S n) -> nat) := ns F0.
Definition tl n (ns : fin (S n) -> nat) := fun i => ns (FS i).

Notation "[ x , y ]" := (fun i => match i with inl _ => x | inr i' => y i' end).

Fixpoint eval n (f : prim_rec n) : (fin n -> nat) -> nat :=
  match f with
    | pr_proj n i => fun ns => ns i
    | pr_succ => fun ns => S (ns F0)
    | pr_const n k => fun _ => k
    | pr_compose m n fs g => fun ns => eval g (fun i => eval (fs i) ns)
    | pr_primrec n f g => fun ns =>
      let fix h m :=
        match m with
          | 0 => eval f (tl ns)
          | S m' => eval g [m', [h m', tl ns]]
        end
        in h (ns F0)
  end.

Theorem ack_is_not_primitive_recursive :
  forall f : prim_rec 2, exists m, exists n,
    eval f (fun i => if i then m else n) <> ack m n.
intro f.
Check prim_rec_ind.
refine (prim_rec_ind
(fun f0:(prim_rec 2)=>exists m,exists n:nat,
eval f0(fun i:fin 2=> if i then m else n)<>ack m n)

 _ _ _ _ _ _).
refine (match f in (prim_rec nnn) return (exists m:nat,
exists n:nat,eval f (fun i : fin 2 => if i then m else n) <> ack m n
)with
|pr_succ=>_
|pr_proj n i=>_
|pr_const n k=>_
|pr_compose m n fs g=>_
|pr_primrec n f g=> _
end).
compute.
simpl.
Check prim_rec_ind.
elim f.
intros.

destruct f as [H n1 i|H|H n k|H m n fs g|H n f g].
simpl.
unfold eval.
fix f.

exists 0.
exists 0.
simpl.
intuition.
elim f.

Admitted.


Require Import rt.util.all.
Require Import rt.model.jitter.task rt.model.jitter.job rt.model.jitter.schedule
               rt.model.jitter.priority rt.model.jitter.workload.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module Interference.

  Import ScheduleOfSporadicTaskWithJitter Priority Workload.

  (* We import some of the basic definitions, but we need to re-define almost everything
     since the definition of backlogged (and thus the definition of interference)
     changes with jitter. *)
  Require Import rt.model.basic.interference.
  Export Interference.

  Section InterferenceDefs.

    Context {sporadic_task: eqType}.
    Context {Job: eqType}.
    Variable job_cost: Job -> time.
    Variable job_task: Job -> sporadic_task.
    Variable job_jitter: Job -> time.

    (* Assume any job arrival sequence...*)
    Context {arr_seq: arrival_sequence Job}.

    (* ... and any schedule. *)
    Context {num_cpus: nat}.
    Variable sched: schedule num_cpus arr_seq.

    (* Consider any job j that incurs interference. *)
    Variable j: JobIn arr_seq.

    (* Recall the definition of backlogged (pending and not scheduled). *)
    Let job_is_backlogged (t: time) :=
      backlogged job_cost job_jitter sched j t.

    Section TotalInterference.

      (* First, we define the total interference incurred by job j during [t1, t2)
         as the cumulative time in which j is backlogged in this interval. *)
      Definition total_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2) job_is_backlogged t.

    End TotalInterference.

    Section JobInterference.

      (* Let job_other be a job that interferes with j. *)
      Variable job_other: JobIn arr_seq.

      (* We define the total interference caused by job_other during [t1, t2) as the
         cumulative service received by job_other while j is backlogged. *)
      Definition job_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2)
          \sum_(cpu < num_cpus)
            (job_is_backlogged t &&
            scheduled_on sched job_other cpu t).

    End JobInterference.

    Section TaskInterference.

      (* In order to define task interference, consider any interfering task tsk_other. *)
      Variable tsk_other: sporadic_task.

      (* We define the total interference caused by tsk during [t1, t2) as
         the cumulative service received by tsk while j is backlogged. *)
      Definition task_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2)
          \sum_(cpu < num_cpus)
            (job_is_backlogged t &&
            task_scheduled_on job_task sched tsk_other cpu t).

    End TaskInterference.

    Section TaskInterferenceJobList.

      Variable tsk_other: sporadic_task.

      Definition task_interference_joblist (t1 t2: time) :=
        \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_other)
         job_interference j t1 t2.

    End TaskInterferenceJobList.

    Section BasicLemmas.

      (* Interference cannot be larger than the considered time window. *)
      Lemma total_interference_le_delta :
        forall t1 t2,
          total_interference t1 t2 <= t2 - t1.
      Proof.
        unfold total_interference; intros t1 t2.
        apply leq_trans with (n := \sum_(t1 <= t < t2) 1);
          first by apply leq_sum; ins; apply leq_b1.
        by rewrite big_const_nat iter_addn mul1n addn0 leqnn.
      Qed.

      Lemma job_interference_le_service :
        forall j_other t1 t2,
          job_interference j_other t1 t2 <= service_during sched j_other t1 t2.
      Proof.
        intros j_other t1 t2; unfold job_interference, service_during.
        apply leq_sum; intros t _.
        unfold service_at; rewrite [\sum_(_ < _ | scheduled_on _ _ _  _)_]big_mkcond.
        apply leq_sum; intros cpu _.
        destruct (job_is_backlogged t); [rewrite andTb | by rewrite andFb].
        by destruct (scheduled_on sched j_other cpu t).
      Qed.

      Lemma task_interference_le_workload :
        forall tsk t1 t2,
          task_interference tsk t1 t2 <= workload job_task sched tsk t1 t2.
      Proof.
        unfold task_interference, workload; intros tsk t1 t2.
        apply leq_sum; intros t _.
        apply leq_sum; intros cpu _.
        destruct (job_is_backlogged t); [rewrite andTb | by rewrite andFb].
        unfold task_scheduled_on, service_of_task.
        by destruct (sched cpu t).
      Qed.

    End BasicLemmas.

    Section InterferenceSequentialJobs.

      (* If jobs are sequential, ... *)
      Hypothesis H_sequential_jobs: sequential_jobs sched.

      (* ... then the interference incurred by a job in an interval
         of length delta is at most delta. *)
      Lemma job_interference_le_delta :
        forall j_other t1 delta,
          job_interference j_other t1 (t1 + delta) <= delta.
      Proof.
        rename H_sequential_jobs into SEQ.
        unfold job_interference, sequential_jobs in *.
        intros j_other t1 delta.
        apply leq_trans with (n := \sum_(t1 <= t < t1 + delta) 1);
          last by rewrite big_const_nat iter_addn mul1n addn0 addKn leqnn.
        apply leq_sum; intros t _.
        destruct ([exists cpu, scheduled_on sched j_other cpu t]) eqn:EX.
        {
          move: EX => /existsP [cpu SCHED].
          rewrite (bigD1 cpu) // /=.
          rewrite big_mkcond (eq_bigr (fun x => 0)) /=;
            first by simpl_sum_const; rewrite leq_b1.
          intros cpu' _; des_if_goal; last by done.
          destruct (scheduled_on sched j_other cpu' t) eqn:SCHED'; last by rewrite andbF.
          move: SCHED SCHED' => /eqP SCHED /eqP SCHED'.
          by specialize (SEQ j_other t cpu cpu' SCHED SCHED'); rewrite SEQ in Heq.
        }
        {
          apply negbT in EX; rewrite negb_exists in EX.
          move: EX => /forallP EX.
          rewrite (eq_bigr (fun x => 0)); first by simpl_sum_const.
          by intros cpu _; specialize (EX cpu); apply negbTE in EX; rewrite EX andbF.
        }
      Qed.

    End InterferenceSequentialJobs.

    (* The sequential per-job interference bounds the actual interference. *)
    Section BoundUsingPerJobInterference.

      Lemma interference_le_interference_joblist :
        forall tsk t1 t2,
          task_interference tsk t1 t2 <= task_interference_joblist tsk t1 t2.
      Proof.
        intros tsk t1 t2.
        unfold task_interference, task_interference_joblist, job_interference, job_is_backlogged.
        rewrite [\sum_(_ <- _ sched _ _ | _) _]exchange_big /=.
        rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
        apply leq_sum; move => t /andP [LEt _].
        rewrite exchange_big /=.
        apply leq_sum; intros cpu _.
        destruct (backlogged job_cost job_jitter sched j t) eqn:BACK;
          last by rewrite andFb (eq_bigr (fun x => 0));
            first by rewrite big_const_seq iter_addn mul0n addn0.
        rewrite andTb.
        destruct (task_scheduled_on job_task sched tsk cpu t) eqn:SCHED; last by done.
        unfold scheduled_on, task_scheduled_on in *.
        destruct (sched cpu t) as [j' |] eqn:SOME; last by done.
        rewrite big_mkcond /= (bigD1_seq j') /=; last by apply undup_uniq.
        {
          by rewrite SCHED eq_refl.
        }
        {
          unfold jobs_scheduled_between.
          rewrite mem_undup; apply mem_bigcat_nat with (j := t);
            first by done.
          apply mem_bigcat_ord with (j := cpu); first by apply ltn_ord.
          by unfold make_sequence; rewrite SOME mem_seq1 eq_refl.
        }
      Qed.

    End BoundUsingPerJobInterference.

  End InterferenceDefs.

End Interference.


Theorem Modus_ponens : forall P Q : Prop, P -> (P -> Q) -> Q.
Proof.
  intros.
  apply (H0 H).
Qed.