(** * 6.822 Formal Reasoning About Programs, Spring 2018 - Pset 7 *)

Require Import Frap Pset9Sig.

(** * 6.822 Formal Reasoning About Programs, Spring 2018 - Pset 7 *)

(** KC: Use can use admitted lemmas in subsequent proofs and
    get the full points for that proof or lemma. For example,
    you can prove the theorem [validator_ok] towards the end
    without proving other lemmas and get 5 ponints. *)

Require Import Frap Pset9Sig.

Ltac iffer :=
  match goal with
  | [H : context [if ?e then _ else _] |- _] => cases e; try equality
  end.

Ltac matcher :=
  match goal with
  | [H : context [match ?e with _ => _ end] |- _] => cases e; try equality
  end.

Ltac split_and :=
  match goal with
  | [H : _ && _ = true |- _] => apply andb_true_iff in H; destruct H
  end.

Ltac invert_Some :=
  match goal with
  | [H : Some _ = Some _ |- _] => invert H
  end.

Hint Constructors plug step0 cstep generate.
Hint Resolve peel_cseq.
Scheme Equality for arith.
Scheme Equality for cmd.

Definition sameValuationExcept (v1 v2: valuation) (md: maydiff) :=
  forall x, md $? x = None -> v1 $? x = v2 $? x.

(* 5 points *)
Lemma arithNotReading_ok:
  forall e md v1 v2,
    arithNotReading e md = true ->
    sameValuationExcept v1 v2 md ->
    interp e v1 = interp e v2.
Proof.
  simplify.

  induct e; simplify; try iffer; try equality.

  unfold sameValuationExcept in H0.
  apply H0 in Heq.
  rewrite Heq. trivial.

  split_and. apply IHe1 with (v1:=v1) (v2:=v2) in H. apply IHe2 with (v1:=v1) (v2:=v2) in H0. rewrite H. rewrite H0. trivial. assumption. assumption.
    split_and. apply IHe1 with (v1:=v1) (v2:=v2) in H. apply IHe2 with (v1:=v1) (v2:=v2) in H0. rewrite H. rewrite H0. trivial. assumption. assumption.
    split_and. apply IHe1 with (v1:=v1) (v2:=v2) in H. apply IHe2 with (v1:=v1) (v2:=v2) in H0. rewrite H. rewrite H0. trivial. assumption. assumption.
Qed.

(* 5 points *)
Lemma sameValuationExcept_add:
  forall v1 v2 md x v,
    sameValuationExcept v1 v2 md ->
    md $? x = None ->
    sameValuationExcept (v1 $+ (x, v)) (v2 $+ (x, v)) md.
Proof.
  simplify.
  unfold sameValuationExcept.
    unfold sameValuationExcept in H.
    simplify.
    cases(x==v x0).
   simplify. trivial.
    simplify. apply H. assumption.
Qed.

(* 5 points *)
Lemma sameValuationExcept_md_add:
  forall v1 v2 md x v v',
    sameValuationExcept v1 v2 md ->
    sameValuationExcept v1 (v2 $+ (x, v)) (md $+ (x, v')).
Proof.
  simplify.
  unfold sameValuationExcept.
  unfold sameValuationExcept in H.
  simplify.
  cases(x==vx0).
  simplify. invert H0.
 simplify. apply H. assumption.
Qed.

Hint Immediate includes_refl.

Check cmd_eq_dec.

(* 2 points *)
Lemma cmd_eq_dec_refl {A} : forall c (t f : A),
    (if cmd_eq_dec c c then t else f) = t.
Proof.

  simplify.
  cases (cmd_eq_dec).
  trivial.
  equality.
Qed.

Ltac rewrite_cmd_eq_dec_refl :=
  match goal with
  | [H : context[if cmd_eq_dec ?c ?c then _ else _] |- _] => rewrite cmd_eq_dec_refl in H
  end.

(* 5 points *)
Lemma validator_same_true_md:
  forall c md nmd,
    validator' c c md = Some nmd -> md = nmd.
Proof.
  induct c; simplify.

  invert H.

  trivial.

  invert H.

  trivial.

  iffer. matcher. iffer. iffer. matcher. matcher.

  matcher.
  apply IHc1 in Heq. rewrite <- Heq in H.  apply IHc2. assumption.

  iffer. matcher. iffer. matcher.

  iffer. iffer. matcher.

  iffer. matcher.
Qed.
Hint Resolve validator_same_true_md sameValuationExcept_md_add sameValuationExcept_add arithNotReading_ok.
Ltac dum:= repeat eauto; rewrite_cmd_eq_dec_refl; eauto.

Lemma validator_step0_ok:
  forall c1 c2 md fmd,
    validator' c1 c2 md = Some fmd ->
    forall v1 v2,
      sameValuationExcept v1 v2 md ->
      forall l v1' c1',
        step0 (v1, c1) l (v1', c1') ->
        exists vc2',
          step0 (v2, c2) l vc2' /\
          (exists nmd,
              validator' c1' (snd vc2') nmd = Some fmd /\
              sameValuationExcept v1' (fst vc2') nmd).
Proof.

  simplify.

  induct H1; simplify; try equality; eauto.

  matcher. invert H. eexists. split. econstructor. eexists. simplify. split. trivial. assumption.
  matcher. iffer. simplify. eexists. split. econstructor. eexists. simplify. split. trivial. invert H.
  apply sameValuationExcept_md_add. assumption.

  matcher. matcher. matcher. iffer. invert e. invert H.
  eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  unfold sameValuationExcept. simplify.  unfold sameValuationExcept in H0.
  apply H0. assumption.

  iffer. iffer. iffer. invert e0. invert H.
  eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  eapply  sameValuationExcept_add. assumption. assumption.

  matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  unfold sameValuationExcept. simplify. unfold sameValuationExcept in H0.
  cases(fmd $?x0). simplify. invert Heq0.
  assert(v1 $? x0 = v2 $? x0).  apply H0. assumption.
  rewrite H1.
   eapply  sameValuationExcept_add. eassumption. eassumption. assumption.

  matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

   matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

   matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

  matcher. matcher. matcher.  invert Heq. eexists. split. econstructor. eexists.
  split. simplify. eassumption. assumption.

  matcher. matcher. matcher. matcher. iffer. invert H. invert e1. eexists. split. econstructor.
  assert(interp e0 v1' = interp e0 v2).
  split_and.  split_and.
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(m). split.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite H in Heq. rewrite H. assumption.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite <- H. assumption.

  matcher. matcher. matcher. iffer. iffer. invert H. invert e1.
eexists. split. eapply Step0IfFalse.
  assert(interp e0 v1' = interp e0 v2).
  split_and.  split_and.
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(m). split.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
    assert(fmd=m0).
  apply validator_same_true_md with (c:=c2_2). assumption.
rewrite <- H. rewrite <-  H2 in Heq0. assumption.
    assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite <- H.
assumption.

  matcher. matcher. iffer. iffer. invert H. invert e1.
  eexists. split. econstructor.  assert(interp e0 v1' = interp e0 v2).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(fmd). split. rewrite Heq.
    assert(fmd=m).
  apply validator_same_true_md with (c:=c2).  assumption. rewrite <- H. rewrite Heq.
  Check cmd_eq_dec.
  cases(cmd_eq_dec). rewrite Heq0. trivial. equality. assumption.

  matcher. matcher. iffer. iffer. invert H. invert e1.
  eexists. split. eapply Step0WhileFalse.  assert(interp e0 v1' = interp e0 v2).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(fmd). split. trivial. assumption.

  matcher. iffer. iffer. invert e1. invert H.
  assert((interp e0 v1' )= (interp e0 v2)).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption.
  rewrite H.
  eexists. split. econstructor.
  exists(fmd). simplify. split. trivial. assumption.

Qed.

(* 5 points *)
Lemma cstep_Sequence:
  forall l v c1 c2 v' c1',
    cstep (v, c1) l (v', c1') ->
    cstep (v, c1 ;; c2) l (v', c1' ;; c2).
Proof.
   simplify.

  induct H; simplify; try equality. eauto.
Qed.

(* 20 points *)
Lemma validator_stepc_ok:
  forall C c c1,
    plug C c c1 ->
    forall c2 md fmd,
      validator' c1 c2 md = Some fmd ->
      forall v1 v2,
        sameValuationExcept v1 v2 md ->
        forall v1' c' l,
          step0 (v1, c) l (v1', c') ->
          forall c1',
            plug C c' c1' ->
            exists vc2' : valuation * cmd,
              cstep (v2, c2) l vc2' /\
              (exists nmd,
                  validator' c1' (snd vc2') nmd = Some fmd /\
                  sameValuationExcept v1' (fst vc2') nmd).
Proof.
  induct 1; simplify.

  invert H2. specialize validator_step0_ok. simplify.
  specialize (H2 c c2 md fmd H v1 v2 H0 l v1' c1' H1). simplify.
  invert H2. cases x. destruct H3. invert H3.
  eexists. propositional.
  2:{ eexists. propositional. eassumption. eassumption. }

  econstructor. econstructor. eassumption. econstructor.

   invert H3. matcher. matcher.
  specialize (IHplug c0_1 md m Heq v1 v2 H1 v1' c'0 l H2 c'1 H8).

  invert IHplug. destruct H3. invert H4. cases x. eexists. propositional.
  eapply cstep_Sequence. eassumption. eexists. propositional. simplify.
  rewrite H4. assumption. assumption.
Qed.

(* 20 points *)
Lemma validator_ok':
  forall md s t,
    (match validator' s t md with
     | Some _ => True
     | None => False
     end)->
    forall sv tv,
      sameValuationExcept sv tv md ->
      (sv, s) =| (tv, t).
Proof.
  simplify.
apply simulation with
    (R := fun vc1 vc2 => exists md, (match validator' (snd vc1) (snd vc2) md with
     | Some _ => True
     | None => False
     end /\  sameValuationExcept (fst vc1) (fst vc2) md) ).

  simplify. matcher. invert H1. destruct H3. matcher. cases vc1. cases vc2. cases vc1'.
  invert H2. specialize (validator_stepc_ok C c2 c H9 c0 x m0 Heq0 v v0 H3 v1 c' l H10 c1 H11).
 (* apply simulation with (R:= fun vc1 vc2 => ((fst vc1) = (fst vc2) /\ (snd vc2) = constAssignCodeMotion (snd vc1)). *)
  simplify. invert H. destruct H1. invert H1. eexists. propositional. eassumption.
  eexists. propositional. rewrite H1. propositional. assumption.

  simplify. invert H1. invert H2. cases c2; try equality.
  simplify. exists md. split. assumption. assumption.
Qed.

(* 5 points *)
Theorem validator_ok:
  forall v s t, validator s t = true -> (v, s) =| (v, t).
Proof.
  simplify.
  unfold validator in H. simplify.
  apply validator_ok' with (md:=$0).
  matcher.
  unfold sameValuationExcept.
  simplify.
  trivial.
Qed.

(* validator_stepc_ok *)
 (*simplify.

  induct H2. simplify.*)

  (*eexists. split. econstructor. econstructor. invert H0. specialize validator_step0_ok. simplify.
  specialize (H0 c1 c2 md fmd). apply H4 in H0. rewrite H4 in H0. simplify.
  apply H0 in H4 with (v1:=v1') (v2:= v2) (v1':=v2') (v2':= v3'). . v1' v2).

 eexists. simplify. split. trivial. assumption.
  matcher. iffer. simplify. eexists. split. econstructor. eexists. simplify. split. trivial. invert H.
  apply sameValuationExcept_md_add. assumption.

  matcher. matcher. matcher. iffer. invert e. invert H.
  eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  unfold sameValuationExcept. simplify.  unfold sameValuationExcept in H0.
  apply H0. assumption.

  iffer. iffer. iffer. invert e0. invert H.
  eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  eapply  sameValuationExcept_add. assumption. assumption.

  matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  unfold sameValuationExcept. simplify. unfold sameValuationExcept in H0.
  cases(fmd $?x0). simplify. invert Heq0.
  assert(v1 $? x0 = v2 $? x0).  apply H0. assumption.
  rewrite H1.
   eapply  sameValuationExcept_add. eassumption. eassumption. assumption.

  matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

   matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

   matcher. iffer. iffer. iffer. invert e0. invert H.
   eexists. split. econstructor. exists(fmd). simplify. split. trivial.
  assert(interp e1 v1 = interp e1 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H. assert(interp e2 v1 = interp e2 v2). eapply arithNotReading_ok. split_and. eassumption. split_and. assumption.
  rewrite H1.   eapply  sameValuationExcept_add. eassumption. eassumption.

  matcher. matcher. matcher.  invert Heq. eexists. split. econstructor. eexists.
  split. simplify. eassumption. assumption.

  matcher. matcher. matcher. matcher. iffer. invert H. invert e1. eexists. split. econstructor.
  assert(interp e0 v1' = interp e0 v2).
  split_and.  split_and.
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(m). split.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite H in Heq. rewrite H. assumption.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite <- H. assumption.

  matcher. matcher. matcher. iffer. iffer. invert H. invert e1.
eexists. split. eapply Step0IfFalse.
  assert(interp e0 v1' = interp e0 v2).
  split_and.  split_and.
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(m). split.
  assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
    assert(fmd=m0).
  apply validator_same_true_md with (c:=c2_2). assumption.
rewrite <- H. rewrite <-  H2 in Heq0. assumption.
    assert(fmd=m).
apply validator_same_true_md with (c:=c2_1). assumption.
rewrite <- H.
assumption.

  matcher. matcher. iffer. iffer. invert H. invert e1.
  eexists. split. econstructor.  assert(interp e0 v1' = interp e0 v2).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(fmd). split. rewrite Heq.
    assert(fmd=m).
  apply validator_same_true_md with (c:=c2).  assumption. rewrite <- H. rewrite Heq.
  Check cmd_eq_dec.
  cases(cmd_eq_dec). rewrite Heq0. trivial. equality. assumption.

  matcher. matcher. iffer. iffer. invert H. invert e1.
  eexists. split. eapply Step0WhileFalse.  assert(interp e0 v1' = interp e0 v2).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption. rewrite <- H. assumption.
   simplify. exists(fmd). split. trivial. assumption.

  matcher. iffer. iffer. invert e1. invert H.
  assert((interp e0 v1' )= (interp e0 v2)).
  apply arithNotReading_ok with (md:=fmd). assumption. assumption.
  rewrite H.
  eexists. split. econstructor.
  exists(fmd). simplify. split. trivial. assumption.

  induct 1; simplify.
  econstructor.
  econstructor.

  invert H0; simplify; try equality.
  invert H. invert H1. eauto. econstructor.

  eauto.
  econstructor.

  eauto.
2:{
  econstructor.
}

  eauto.

  eassumption.

  eauto.
  cases(cmd_eq_dec c1 Skip).
  rewrite e.
  invert e.
 eapply Step0Seq.
  rewrite e in H0. invert H0.
2: {eauto. }

  simplify.
  assert(exists vc2',
          step0 (v2, c2) l vc2' /\
          (exists nmd,
              validator' c1' (snd vc2') nmd = Some fmd /\
              sameValuationExcept v1' (fst vc2') nmd)).

  apply validator_step0_ok with (c1:=c) (md:=md) (v1:=v1).
  assumption. assumption. assumption.

  induct H; induct H3.
  assert( exists vc2', step0 (v2, c2) l vc2' /\
          (exists nmd,
              validator' c0 (snd vc2') nmd = Some fmd /\
              sameValuationExcept v1' (fst vc2') nmd)).
  eapply validator_step0_ok.
  eassumption.
  eassumption.
  eassumption.

  invert H. destruct H3. cases(x).
  exists (v,c1).
  split.
  econstructor. econstructor. eassumption. econstructor.
  assumption.

  invert H0. matcher. matcher.
eapply IHplug0.

  eexists. cases(vc2').
  eapply IHplug0.

  2: { eassumption. }
  econstructor.
  econstructor.

  cases(x).
  exists v c.
  invert H.
  eassumption.
  eassumption.*)

(* validator'_ok *)
(*  simplify. propositional.
  cases vc2.
  invert H2; simplify; subst.
  invert H1. matcher. invert H2.

  eapply validator_stepc_ok in H4.
  invert H4. destruct H2.
  invert H4. destruct H7.
  eexists. propositional. exact H2.

  eexists.
2:{ econstructor. }
3:{ eassumption. }
3:{ econstructor. }

split. 2:{
  exact H7. }

invert H4. destruct H7. exact H7. }
induct H2; eauto.

matcher. induct ; eauto.
2:{
split. matcher.

invert H2.  cases x0. simplify.

  invert H4. destruct H2. cases vc2. exact H2. simplify. matcher.
  simple eapply CStep.
 simple apply plug_cfoldExprs1.
  exact H.
  exact H3.
  simple apply plug_cfoldExprs1.
   exact H4.
  apply cfoldExprs_ok' in H3.

  cases vc2. simplify. subst. (* [H2] *)
  info_eauto.
  simplify. trivial.
  equality.

  simplify.  propositional.
  eexists; propositional.
  cases vc2.
  specialize skip_or_step.
  simplify. specialize (H3 v c). propositional. invert H4. invert H1. matcher. invert Heq. invert H4.
  cases(snd vc1). invert H5. econstructor. econstructor. econstructor.

invert H3.
  simplify. subst. econstructor. econstructor. 2:{ econstructor. }
  invert Heq.
  econstructor.
  info_eauto.
2:{ eassumption.
  simplify. trivial.
  equality.

    2: { simplify. propositional. matcher.  } (* agree_on_termination *)
  2: { simplify. propositional. } (* R *)
  simplify. propositional. (* one_step *)

  (* apply simulation *)
*)


Require Export Arith.EqNat.
Require Export Arith.Le.
Require Import Coq.Program.Equality.
Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Require Import Psatz.
Require Import Coq.Arith.Compare_dec.
Import ListNotations.

Require Import Coq.Logic.ProofIrrelevance.

Require Import vars.
Require Import env.
Require Import tactics.
Require Import NatSets.
Require Import setfacts.

Import NatSet.F.

(* Type qualifiers. *)

Inductive qual : Type :=
| qbot (* untracked *)
| qset : nats(* free variables *) -> nats(* bound variables *) -> nats(* store locations *) -> qual
.

Definition just_fv (x : id) : qual := qset (singleton x) {}N {}N.
Definition just_bv (x : id) : qual := qset {}N (singleton x) {}N.
Definition just_loc (l : loc) : qual := qset {}N {}N (singleton l).

Definition qfvs (q: qual) : nats :=
  match q with
  | qbot => {}N
  | qset fvs _ _ => fvs
  end.

Definition qbvs (q: qual) : nats :=
  match q with
  | qbot => {}N
  | qset _ bvs _ => bvs
  end.

Definition qlocs (q: qual) : nats :=
  match q with
  | qbot => {}N
  | qset _ _ ls => ls
  end.

Definition qmemb (v : var + loc) (d : qual) : bool  :=
  match d with
  | qbot => false
  | qset vs bs ls => match v with
                    | inl (varF v) => mem v vs
                    | inl (varB v) => mem v bs
                    | inr l        => mem l ls
                    end
  end.

Definition qmem (v : var + loc) (d : qual) : Prop :=
  match d with
  | qbot => False
  | qset vs bs ls => match v with
                    | inl (varF v) => In v vs
                    | inl (varB v) => In v bs
                    | inr l        => In l ls
                    end
  end.

Definition subqual (d1 d2 : qual) : Prop :=
  match d1 , d2 with
  | qbot, _ => True
  | _, qbot => False
  | qset fs1 bs1 ls1 , qset fs2 bs2 ls2 => (Subset fs1 fs2) /\ (Subset bs1 bs2) /\ (Subset ls1 ls2)
  end.

Definition subqualb (d1 d2 : qual) : bool :=
  match d1, d2 with
  | qbot, _ => true
  | _, qbot => false
  | qset vs1 bs1 ls1, qset vs2 bs2 ls2 =>
    fold_right andb true [(subset vs1 vs2); (subset bs1 bs2); (subset ls1 ls2)]
  end.

Definition eqqual (d1 d2 : qual) : Prop :=
  match d1 , d2 with
  | qbot, qbot => True
  | qset fs1 bs1 ls1 , qset fs2 bs2 ls2 => (Equal fs1 fs2) /\ (Equal bs1 bs2) /\ (Equal ls1 ls2)
  | _, _ => False
  end.

Definition eqqualb (d1 d2 : qual): bool :=
  match d1 , d2 with
  | qbot, qbot => true
  | qset fs1 bs1 ls1 , qset fs2 bs2 ls2 => (equal fs1 fs2) && (equal bs1 bs2) && (equal ls1 ls2)
  | _, _ => false
  end.

(* Semilattice ops on qualifiers *)
Definition qlub (d1 d2 : qual) : qual :=
  match d1, d2 with
  | qbot, d2 => d2
  | d1, qbot => d1
  | qset vs1 bs1 ls1, qset vs2 bs2 ls2 => qset (union vs1 vs2) (union bs1 bs2) (union ls1 ls2)
  end.

Definition qglb (d1 d2 : qual) : qual :=
  match d1, d2 with
  | qbot, _ => qbot
  | _, qbot => qbot
  | qset vs1 bs1 ls1, qset vs2 bs2 ls2 => qset (inter vs1 vs2) (inter bs1 bs2) (inter ls1 ls2)
  end.

Definition qplus (d : qual) (x : id) : qual :=
  match d with
  | qbot => qbot
  | q => qlub d (just_fv x)
  end.

(* The cancelling union generalized to qualifiers as second arg *)
Definition qqplus (q1 q2 : qual) : qual :=
  match q1 with
  | qbot => qbot
  | q    => qlub q1 q2
  end.

(* The intersection as used by T-App *)
Definition qqcap (q1 q2 : qual) : qual :=
  match (q1, q2) with
  | (qbot, qbot) => qbot
  | (qbot, _) => (qset {}N {}N {}N)
  | (_, qbot) => (qset {}N {}N {}N)
  | (_, _) => qglb q1 q2
  end.

Definition ldom {A} (Σ : list A) := qset {}N {}N (dom Σ).
#[global] Hint Unfold ldom : core.

Module QualNotations.
  Declare Scope qualifiers.

  Notation "⊥" := qbot (at level 9) : qualifiers.
  Notation "∅" := (qset {}N {}N {}N) (at level 9) : qualifiers.

  Notation "l ∈ₗ d"  := (qmem (inr l) d) (at level 75) : qualifiers.
  Notation "v ∈ᵥ d"  := (qmem (inl v) d) (at level 75) : qualifiers.
  Notation "l ∈?ₗ d" := (qmemb (inr l) d) (at level 75) : qualifiers.
  Notation "v ∈?ᵥ d" := (qmemb (inl v) d) (at level 75) : qualifiers.

  Notation "$$ x " := (just_fv x) (at level 0, right associativity) : qualifiers.
  Notation "## x " := (just_bv x) (at level 0, right associativity) : qualifiers.
  Notation "&& l " := (just_loc l) (at level 0, right associativity) : qualifiers.

  Notation "d1 ⊑ d2" := (subqual d1 d2) (at level 75) : qualifiers.
  Notation "d1 ⊑? d2" := (subqualb d1 d2) (at level 75) : qualifiers.

  Notation "d1 ≡ d2" := (eqqual d1 d2) (at level 75) : qualifiers.
  Notation "d1 ≡? d2" := (eqqualb d1 d2) (at level 75) : qualifiers.

  Notation "d1 ⊔ d2" := (qlub d1 d2) (at level 70, right associativity) : qualifiers.
  Notation "d1 ⊓ d2" := (qglb d1 d2) (at level 65, right associativity) : qualifiers.

  Notation "d1 ⊕ x" := (qplus d1 x) (at level 70) : qualifiers.

  Notation "q1 ⋓ q2" := (qqplus q1 q2) (at level 70, right associativity) : qualifiers.
  Notation "q1 ⋒ q2" := (qqcap q1 q2) (at level 65, right associativity) : qualifiers.

End QualNotations.
Import QualNotations.
Local Open Scope qualifiers.

Require Import Coq.Bool.Bool.

Lemma qmem_reflect : forall {v d}, reflect (qmem v d) (qmemb v d).
  intros. destruct d.
  - simpl. constructor. intuition.
  - simpl. destruct v. destruct v.
    destruct (mem i t0) eqn:Hmem; try constructor; intuition.
    rewrite <- NatSetFacts.not_mem_iff in Hmem. auto.
    destruct (mem i t1) eqn:Hmem; try constructor; intuition.
    rewrite <- NatSetFacts.not_mem_iff in Hmem. auto.
    destruct (mem l t2) eqn:Hmem; try constructor; intuition.
    rewrite <- NatSetFacts.not_mem_iff in Hmem. auto.
Qed.

Lemma qmem_decidable : forall v d, {qmem v d} + {~ qmem v d}.
  intros. eapply reflect_dec. apply qmem_reflect.
Qed.

Lemma subqual_reflect : forall {d1 d2}, reflect (subqual d1 d2) (subqualb d1 d2).
Proof.
  intros.
  destruct (d1 ⊑? d2) eqn:Hsub; try constructor;
    destruct d1; destruct d2; simpl in *; intuition;
    repeat rewrite andb_true_iff in Hsub; intuition.
  repeat rewrite andb_false_iff in Hsub. intuition.
  apply subset_1 in H0. rewrite H0 in H1. discriminate.
  apply subset_1 in H. rewrite H in H3. discriminate.
  apply subset_1 in H2. rewrite H2 in H1. discriminate.
Qed.

Lemma subqual_decidable : forall d1 d2, {d1 ⊑ d2} + {~ d1 ⊑ d2}.
  intros. eapply reflect_dec. apply subqual_reflect.
Qed.

Lemma subqualb_true_iff : forall {d1 d2}, (d1 ⊑? d2) = true <-> d1 ⊑ d2.
  intuition. erewrite reflect_iff. eauto. apply subqual_reflect.
  erewrite <- reflect_iff; eauto. apply subqual_reflect.
Qed.

Lemma subqualb_false_iff : forall {d1 d2}, (d1 ⊑? d2) = false <-> ~ d1 ⊑ d2.
  intuition. rewrite <- subqualb_true_iff in H0. rewrite H in H0.
  discriminate. destruct (d1 ⊑? d2) eqn:Heq.
  rewrite subqualb_true_iff in Heq. contradiction.
  auto.
Qed.

Lemma eqqual_reflect : forall {d1 d2}, reflect (eqqual d1 d2) (eqqualb d1 d2).
Proof.
  intros. destruct d1; destruct d2; simpl; intuition.
  apply iff_reflect. split; intros; intuition.
  apply equal_1 in H0. apply equal_1 in H. apply equal_1 in H2. intuition.
  1-3: repeat rewrite andb_true_iff in H; intuition; fnsetdec.
Qed.

Lemma eqqual_decidable : forall d1 d2, {d1 ≡ d2} + {~ d1 ≡ d2}.
  intros. eapply reflect_dec. apply eqqual_reflect.
Qed.

(* Lifts the extensional equality of the underlying set impl to qualifiers *)
Lemma eq_if_eqqual : forall {d1 d2}, d1 ≡ d2 -> d1 = d2.
  intros. destruct d1; destruct d2; auto; inversion H. unfold eqqual in H. intuition.
  f_equal; apply NatSet.eq_if_Equal; auto.
Qed.

Lemma subqual_refl : forall {d1}, d1 ⊑ d1.
  intros. unfold subqual.
  destruct d1; intuition.
Qed.
#[global] Hint Resolve subqual_refl : core.

Lemma subqual_trans : forall {d1 d2 d3}, d1 ⊑ d2 -> d2 ⊑ d3 -> d1 ⊑ d3.
  intros. unfold subqual in *. destruct d1; auto.
  destruct d2; auto; intuition. destruct d3; auto. fnsetdec.
Qed.

Lemma subqual_antisymm : forall {d1 d2}, d1 ⊑ d2 -> d2 ⊑ d1 -> d1 ≡ d2.
  intros. unfold eqqual in *. unfold subqual in *.
  destruct d1; auto. destruct d2; auto. intuition.
Qed.

Lemma eqqual_refl : forall {d}, d ≡ d.
  intros. unfold eqqual. destruct d; auto. intuition.
Qed.
#[global] Hint Resolve eqqual_refl : core.

Lemma eqqual_sym : forall {d1 d2}, d1 ≡ d2 -> d2 ≡ d1.
  unfold eqqual. destruct d1; auto. destruct d2; auto. intuition.
Qed.

Lemma eqqual_trans : forall {d1 d2 d3}, d1 ≡ d2 -> d2 ≡ d3 -> d1 ≡ d3.
  unfold eqqual. destruct d1; auto; destruct d2; auto; destruct d3; auto;
                   intros; intuition; fnsetdec.
Qed.

Ltac qdec :=
  try apply eq_if_eqqual;
  try unfold qglb in *;
  try unfold qlub in *;
  try unfold eqqual in *;
  try unfold subqual in *;
  simpl;
  intuition;
  try apply NatSet.eq_if_Equal; NatSetDecide.fsetdec.

Lemma subqual_plus : forall {d1 d2}, d1 ⊑ d2 -> forall {x}, d1 ⊕ x ⊑ d2 ⊕ x.
  intros. destruct d1; auto; destruct d2; auto; simpl in *; intuition; fnsetdec.
Qed.

Lemma qplus_empty : forall {x}, ∅ ⊕ x = (just_fv x).
  intros. compute. repeat rewrite empty_union_left. auto.
Qed.

Lemma qmem_lub_or_commute: forall {vl d1 d2}, qmem vl (d1 ⊔ d2) <-> qmem vl d1 \/ qmem vl d2.
  destruct d1; auto; destruct d2; auto; simpl; intuition; destruct a; fnsetdec.
Qed.

Lemma qmem_glb_and_commute: forall {vl d1 d2}, qmem vl (d1 ⊓ d2) <-> qmem vl d1 /\ qmem vl d2.
  destruct d1; auto; destruct d2; auto; simpl; intuition; try fnsetdec; destruct a; fnsetdec.
Qed.

Lemma qlub_is_lub : forall {d1 d2},
    d1 ⊑ (d1 ⊔ d2) /\
    d2 ⊑ (d1 ⊔ d2) /\
    forall {d3}, d1 ⊑ d3 /\ d2 ⊑ d3 -> (d1 ⊔ d2) ⊑ d3.
  destruct d1; auto; destruct d2; auto; intuition; unfold subqual; auto;
    simpl; unfold qlub; intuition.
  destruct d3; intuition; unfold subqual in *; try fnsetdec.
Qed.

Lemma qglb_is_glb : forall {d1 d2},
    (d1 ⊓ d2) ⊑ d1 /\
    (d1 ⊓ d2) ⊑ d2 /\
      forall {d3}, d3 ⊑ d1 /\ d3 ⊑ d2 -> d3 ⊑ (d1 ⊓ d2).
  destruct d1; auto; destruct d2; auto; simpl; intuition.
  destruct d3; auto. unfold subqual.
  destruct H0. destruct H1. intuition; try fnsetdec.
Qed.

Lemma qlub_empty_right : forall {d}, d <> qbot -> (d ⊔ ∅) = d.
  intros. destruct d; qdec.
Qed.
#[global] Hint Resolve qlub_empty_right : core.

Lemma qglb_empty_right : forall {d}, d <> qbot -> (d ⊓ ∅) = ∅.
  intros. destruct d; qdec.
Qed.
#[global] Hint Resolve qglb_empty_right : core.

Lemma qglb_empty_left : forall {d}, d <> qbot -> (∅ ⊓ d) = ∅.
  intros. destruct d; qdec.
Qed.
#[global] Hint Resolve qglb_empty_left : core.

Lemma qlub_idem : forall {q}, (q ⊔ q) = q.
 intros. destruct q; qdec.
Qed.

Lemma qlub_assoc : forall {q1 q2 q3},
    (q1 ⊔ (q2 ⊔ q3)) = ((q1 ⊔ q2) ⊔ q3).
Proof.
  intros. destruct q1, q2, q3; simpl; qdec.
Qed.

Lemma qglb_qlub_dist : forall {d1 d2 d3}, (d1 ⊓ (d2 ⊔ d3)) = ((d1 ⊓ d2) ⊔ (d1 ⊓ d3)).
  destruct d1; destruct d2; destruct d3; qdec.
Qed.

Lemma qglb_commute : forall {d1 d2}, d1 ⊓ d2 = d2 ⊓ d1.
  intros. destruct d1; destruct d2; qdec.
Qed.

Lemma qlub_commute : forall {d1 d2}, (d1 ⊔ d2) = (d2 ⊔ d1).
  intros. destruct d1; destruct d2; qdec.
Qed.

Lemma qlub_empty_left : forall {d}, d <> qbot -> (∅ ⊔ d) = d.
  intros. rewrite qlub_commute. auto.
Qed.
#[global] Hint Resolve qlub_empty_left : core.

Lemma qqcap_commute:  forall {d1 d2}, d1 ⋒ d2 = d2 ⋒ d1.
Proof.
  intros. destruct d1, d2; qdec.
Qed.

Lemma qqplus_qbot_right_neutral : forall {d}, (d ⋓ qbot) = d.
  destruct d; simpl; intros; intuition.
Qed.
#[global] Hint Resolve qqplus_qbot_right_neutral : core.

Lemma qqplus_gt : forall {q1 q2}, q1 ⊑ (q1 ⋓ q2).
  destruct q1; destruct q2; simpl; intuition.
Qed.
#[global] Hint Resolve qqplus_gt : core.

Lemma subqual_qlub : forall {d1 d2 d}, d1 ⊑ d2 -> d1 ⊔ d ⊑ d2 ⊔ d.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma subqual_qglb : forall {d1 d2 d}, d1 ⊑ d2 -> d ⊓ d1 ⊑ d ⊓ d2.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma subqual_qglb_r : forall {d1 d2 d}, d1 ⊑ d2 -> d1 ⊓ d ⊑ d2 ⊓ d.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma subqual_qqplus : forall {d1 d2 d}, d1 ⊑ d2 -> d1 ⋓ d ⊑ d2 ⋓ d.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma subqual_qlub_l : forall {d1 d2 d}, d1 ⊑ d2 -> d ⊔ d1 ⊑ d ⊔ d2.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma subqual_qqplus_l : forall {d1 d2 d}, d1 ⊑ d2 -> d ⋓ d1 ⊑ d ⋓ d2.
  destruct d1; destruct d2; destruct d; qdec.
Qed.

Lemma qbot_smallest : forall {d}, qbot ⊑ d.
  intros. destruct d; simpl; qdec.
Qed.
#[global] Hint Resolve qbot_smallest : core.

Lemma empty_smallest_set : forall {d}, d <> qbot -> ∅ ⊑ d.
  intros. destruct d; simpl; qdec.
Qed.
#[global] Hint Resolve empty_smallest_set : core.

Lemma empty_superqual : forall {df}, df <> qbot -> df ⊑ ∅ -> df = ∅.
  intros. destruct df. simpl in *. intuition. qdec.
Qed.

Lemma qlub_qglb_dist_r:
  forall {d1 d2 d3 : qual}, ((d2 ⊓ d3) ⊔ d1) = ((d2 ⊔ d1) ⊓ (d3 ⊔ d1)).
  destruct d1; destruct d2; destruct d3; qdec.
Qed.

Lemma qlub_qglb_dist_l:
  forall {d1 d2 d3 : qual}, ((d2 ⊓ d3) ⊔ d1) = ((d2 ⊔ d1) ⊓ (d3 ⊔ d1)).
  destruct d1; destruct d2; destruct d3; simpl; qdec.
Qed.

Lemma qglb_qlub_dist_r:
  forall {d1 d2 d3 : qual}, ((d2 ⊔ d3) ⊓ d1) = ((d2 ⊓ d1) ⊔ (d3 ⊓ d1)).
  destruct d1; destruct d2; destruct d3; simpl; qdec.
Qed.

Lemma qglb_qlub_dist_l:
  forall {d1 d2 d3 : qual}, (d1 ⊓ (d2 ⊔ d3)) = ((d1 ⊓ d2) ⊔ (d1 ⊓ d3)).
  destruct d1; destruct d2; destruct d3; simpl; qdec.
Qed.

Lemma empty_neutral_set : forall {a b c}, ((qset a b c) ⊔ ∅) = (qset a b c).
Proof. intros. simpl. repeat rewrite empty_union_right. auto. Qed.

Lemma empty_smallest_set' : forall {l1 l2 l3}, ∅ ⊑ qset l1 l2 l3.
Proof.
  intros. simpl. intuition.
Qed.

Lemma qlub_swallow_l : forall {q1 q2}, q1 ⊑ q2 -> (q1 ⊔ q2) = q2.
  intros. destruct q1; destruct q2; simpl; auto; qdec.
Qed.

Lemma qlub_swallow_r : forall {q1 q2}, q1 ⊑ q2 -> (q2 ⊔ q1) = q2.
  intros. destruct q1; destruct q2; simpl; auto; qdec.
Qed.

Lemma qqplus_swallow_r : forall {q1 q2}, q1 ⊑ q2 -> (q2 ⋓ q1) = q2.
  intros. destruct q1; destruct q2; simpl; auto; qdec.
Qed.

Lemma qlub_bound : forall {q1 q2 q3}, q1 ⊑ q3 -> q2 ⊑ q3 -> q1 ⊔ q2 ⊑ q3.
  intros. destruct q1; destruct q2; destruct q3; qdec.
Qed.

Lemma qqplus_bound : forall {q1 q2 q3}, q1 ⊑ q3 -> q2 ⊑ q3 -> q1 ⋓ q2 ⊑ q3.
  intros. destruct q1; destruct q2; destruct q3; qdec.
Qed.

Lemma qglb_bound : forall {q1 q2 q3}, q3 ⊑ q1 -> q3 ⊑ q2 -> q3 ⊑ q1 ⊓ q2.
  intros. destruct q1; destruct q2; destruct q3; qdec.
Qed.

Lemma qqcap_bound : forall {q1 q2 q3}, q3 ⊑ q1 -> q3 ⊑ q2 -> q3 ⊑ q1 ⋒ q2.
  intros. destruct q1; destruct q2; destruct q3; qdec.
Qed.

Lemma subqual_bound : forall {q1 q2},
    q1 ⊑ q2 ->
    (bound (qfvs q1)) <= (bound (qfvs q2))
    /\ (bound (qbvs q1)) <= (bound (qbvs q2))
    /\ (bound (qlocs q1)) <= (bound (qlocs q2)).
  intros. destruct q1; destruct q2; simpl in *; intuition; apply subset_bound'; fnsetdec.
Qed.

Lemma subqual_plus_var_bound : forall {q1 x q2},
    q1 <> qbot ->
    q1 ⊕ x ⊑ q2 -> x < bound (qfvs q2).
  intros q1 x q2 Hq1 H. apply subqual_bound in H. intuition.
  destruct q1; intuition.
  simpl in *. apply bound_union in H0. intuition.
  rewrite bound_singleton in H3. lia.
Qed.

Lemma subqual_just_loc_bound : forall {l q},
    just_loc l ⊑ q -> l < bound (qlocs q).
  intros. apply subqual_bound in H. intuition. simpl in *.
  rewrite bound_singleton in H2. lia.
Qed.

Lemma subqual_just_fv_bound : forall {x q},
    just_fv x ⊑ q -> x < bound (qfvs q).
  intros. apply subqual_bound in H. intuition. simpl in *.
  rewrite bound_singleton in H0. lia.
Qed.

Lemma subqual_qplus : forall {q x}, q ⊑ q ⊕ x.
  intros. destruct q; simpl; intuition; fnsetdec.
Qed.
#[global] Hint Resolve subqual_qplus : core.

Lemma qset_empty_inv : forall {a b c}, qset a b c = ∅ <->  a [=] {}N /\ b [=] {}N /\ c [=] {}N.
  intros. split. intros.
  inversion H. intuition.
  intros. intuition. f_equal; fnsetdec.
Qed.

Lemma qlub_qbot_left : forall {d}, (qbot ⊔ d) = d.
Proof. intros. destruct d; simpl; auto. Qed.

Lemma glb_qbot : forall {d}, d ⊓ qbot = qbot.
Proof. intros. destruct d; simpl; auto. Qed.

Lemma qqcap_lub_empty_preserve : forall {d1 d2}, d1 ⋒ d2 ⊑ ∅ -> d1 ⋒ (d2 ⊔ ∅) ⊑ ∅.
Proof.
  intros. destruct d1; destruct d2; simpl in *; intuition; fnsetdec.
Qed.

Lemma qlub_empty : forall {d}, d ⊑ d ⊔ ∅.
Proof.
  intros. destruct d; simpl; auto. intuition; fnsetdec.
Qed.

Lemma qqplus_empty_right_neutral : forall {d}, d <> qbot -> (d ⋓ ∅) = d.
  destruct d; simpl; intros; intuition.
  repeat rewrite empty_union_right. auto.
Qed.

Lemma qbot_is_bottom : forall q, q ⊑ qbot -> q = qbot.
Proof.
  intros. destruct q; auto. simpl in H. inversion H.
Qed.

Lemma qqcap_sub_l : forall {q1 q2}, q1 <> qbot -> q1 ⋒ q2 ⊑ q1.
  intros. destruct q1 eqn:Hq1; destruct q2 eqn:Hq2; simpl; intuition.
Qed.

Lemma qqcap_sub_r : forall {q1 q2}, q1 <> qbot -> q2 ⋒ q1 ⊑ q1.
  intros. destruct q1; destruct q2; simpl; intuition.
Qed.

Lemma qqcap_qbot : forall d1 d2, d1 ⋒ d2 ⊑ qbot -> d1 = qbot /\ d2 = qbot.
Proof.
  intros. destruct d1; destruct d2; simpl; intuition; inversion H.
Qed.

Lemma qqcap_qbot' : forall d1 d2, d1 ⋒ d2 = qbot -> d1 = qbot /\ d2 = qbot.
Proof.
  intros. destruct d1; destruct d2; simpl; intuition; inversion H.
Qed.

Lemma qqcap_lub_empty_preserve' : forall {d1 d2 d3},
    d1 ⋒ d2 ⊑ ∅ -> d3 ⋒ d1 = ∅ -> d1 ⋒ (d2 ⋓ d3) ⊑ ∅.
Proof.
  intros. destruct d1; destruct d2; destruct d3; simpl in *; intuition; cbv in H0;
  apply qset_empty_inv in H0; intuition; fnsetdec.
Qed.

Lemma subqual_qqcap' :  forall {a b c d'}, qset a b c ⋒ d' ⊑ qset a b c.
  destruct d'.
  - simpl. intuition.
  - specialize @qglb_is_glb with (d1:=(qset a b c)) (d2:=(qset t0 t1 t2)). intuition.
Qed.

Lemma qual_less_than_empty : forall q, q ⊑ ∅ <-> q = qbot \/ q = ∅.
Proof.
  intros. split.
  - destruct q; simpl in *. left. auto. right.
    intuition. apply subset_of_empty in H0, H, H2. subst. auto.
  - destruct q; simpl in *; intros; auto.
    destruct H. discriminate H. inversion H. intuition; fnsetdec.
Qed.

Lemma just_fv_mem_iff : forall {x y}, $x ∈ᵥ just_fv y <-> x = y.
  intros. simpl. rewrite NatSetFacts.singleton_iff. intuition.
Qed.

Lemma qglb_bot_right : forall {d}, (d ⊓ qbot) = qbot.
  intros. destruct d; qdec.
Qed.
#[global] Hint Resolve qglb_bot_right : core.

Lemma qglb_bot_left : forall {d}, (qbot ⊓ d) = qbot.
  intros. destruct d; qdec.
Qed.
#[global] Hint Resolve qglb_bot_left : core.


Require Import CoqPerformanceTests.typeclass_reification_common.
Time Definition foo210 : goal 210. Time solve_P. Time Qed.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import ZArith.
Require Import Rbase.
Definition unit  := unit.

Parameter qtmark : Type.

Parameter at1: forall (a:Type), a -> qtmark -> a.

Implicit Arguments at1.

Parameter old: forall (a:Type), a -> a.

Implicit Arguments old.

Definition implb(x:bool) (y:bool): bool := match (x,
  y) with
  | (true, false) => false
  | (_, _) => true
  end.

Definition key  := Z.

Definition value  := Z.

Inductive color  :=
  | Red : color
  | Black : color .

Inductive tree  :=
  | Leaf : tree
  | Node : color -> tree -> Z -> Z -> tree -> tree .

Set Implicit Arguments.
Fixpoint memt(t:tree) (k:Z) (v:Z) {struct t}: Prop :=
  match t with
  | Leaf => False
  | (Node _ l kqt vqt r) => ((k = kqt) /\ (v = vqt)) \/ ((memt l k v) \/
      (memt r k v))
  end.
Unset Implicit Arguments.

Axiom memt_color : forall (l:tree) (r:tree) (k:Z) (kqt:Z) (v:Z) (vqt:Z)
  (c:color) (cqt:color), (memt (Node c l k v r) kqt vqt) -> (memt (Node cqt l
  k v r) kqt vqt).

Definition lt_tree(x:Z) (t:tree): Prop := forall (k:Z), forall (v:Z), (memt t
  k v) -> (k <  x)%Z.

Definition gt_tree(x:Z) (t:tree): Prop := forall (k:Z), forall (v:Z), (memt t
  k v) -> (x <  k)%Z.

Set Implicit Arguments.
Fixpoint bst(t:tree) {struct t}: Prop :=
  match t with
  | Leaf => True
  | (Node _ l k v r) => (bst l) /\ ((bst r) /\ ((lt_tree k l) /\ (gt_tree k
      r)))
  end.
Unset Implicit Arguments.

Axiom bst_Leaf : (bst Leaf).

Definition is_not_red(t:tree): Prop :=
  match t with
  | (Node Red _ _ _ _) => False
  | (Leaf|(Node Black _ _ _ _)) => True
  end.

Set Implicit Arguments.
Fixpoint rbtree(n:Z) (t:tree) {struct t}: Prop :=
  match t with
  | Leaf => (n = 0%Z)
  | (Node Red l _ _ r) => (rbtree n l) /\ ((rbtree n r) /\ ((is_not_red l) /\
      (is_not_red r)))
  | (Node Black l _ _ r) => (rbtree (n - 1%Z)%Z l) /\ (rbtree (n - 1%Z)%Z r)
  end.
Unset Implicit Arguments.

Axiom rbtree_Leaf : (rbtree 0%Z Leaf).

Axiom rbtree_Node1 : forall (k:Z) (v:Z), (rbtree 0%Z (Node Red Leaf k v
  Leaf)).

Definition almost_rbtree(n:Z) (t:tree): Prop :=
  match t with
  | Leaf => (n = 0%Z)
  | (Node Red l _ _ r) => (rbtree n l) /\ (rbtree n r)
  | (Node Black l _ _ r) => (rbtree (n - 1%Z)%Z l) /\ (rbtree (n - 1%Z)%Z r)
  end.

(* YOU MAY EDIT THE CONTEXT BELOW *)

(* DO NOT EDIT BELOW *)

Theorem WP_parameter_add : forall (t:tree), forall (k:Z), forall (v:Z),
  ((bst t) /\ exists n:Z, (rbtree n t)) -> (((bst t) /\ exists n:Z, (rbtree n
  t)) -> forall (result:tree), ((bst result) /\ ((forall (n:Z), (rbtree n
  t) ->
  (match result with
  | Leaf => (n = 0%Z)
  | (Node Red l _ _ r) => (rbtree n l) /\ (rbtree n r)
  | (Node Black l _ _ r) => (rbtree (n - 1%Z)%Z l) /\ (rbtree (n - 1%Z)%Z r)
  end /\
  (match t with
  | (Node Red _ _ _ _) => False
  | (Leaf|(Node Black _ _ _ _)) => True
  end -> (rbtree n result)))) /\ ((memt result k v) /\ forall (kqt:Z)
  (vqt:Z), ((memt result kqt vqt) \/ (((kqt = k) -> (vqt = v)) /\
  ((~ (kqt = k)) -> (memt t kqt vqt)))) -> ((memt result kqt vqt) /\
  (((kqt = k) /\ (vqt = v)) \/ ((~ (kqt = k)) /\ (memt t kqt vqt))))))) ->
  match result with
  | (Node _ l kqt vqt r) => exists n:Z, (rbtree n (Node Black l kqt vqt r))
  | Leaf => True
  end).
(* YOU MAY EDIT THE PROOF BELOW *)
intuition.
destruct result; auto.
destruct H2 as (n, h). clear H3.
generalize (H0 n h); clear H0.
intros.
destruct c; intuition.
(* c = Red *)
exists (n+1)%Z; intuition.
simpl rbtree. replace (n+1-1)%Z with n by omega.
intuition.
(* c = Black *)
exists n; intuition.
simpl rbtree.
intuition.
Qed.
(* DO NOT EDIT BELOW *)


Require Import Commons.

Section Lists.

Context {X : eqType}.

Definition weak_cons (x : X) := bind (fun (xs : list X) => Some (x :: xs)).

Definition weak_app (xs : seq X) ys :=
match ys with
 | Some ys => Some (xs ++ ys)
 | None => None
end.

Notation "x :~: xs" := (weak_cons x xs) (at level 60, right associativity) : seq_scope.
Notation "x :++: xs" := (weak_app x xs) (at level 56, left associativity) : seq_scope.
Open Scope seq_scope.

Lemma cons_wcons (x : X) l : Some (x :: l) = x :~: Some l.
Proof. done. Qed.

Lemma wcons_none x o: x :~: o = None -> o = None.
Proof. by move: o => []. Qed.

Lemma wcons_some x o o1: x :~: o = Some o1 -> exists o2, o = Some o2 /\ o1 = x :: o2.
Proof. by move: o => [a [<-]|] //; eauto. Qed.

Lemma weak_app_0s: forall xs, [::] :++: xs = xs.
Proof. by move=> [xs|]. Qed.

(* Insert list operation and its properties *)
Fixpoint ins (i : nat) (es : seq X) (xs : seq X) :=
 match i with
   0 => Some (es ++ xs)
   | S i' =>
     match xs with
       | x' :: xs' => x' :~: ins i' es xs'
       | _ => None
     end
 end.

Definition oins (i : nat) (es : seq X) :=
  bind (ins i es).

Lemma oins_some n es xs: ins n es xs = oins n es (Some xs).
Proof. done. Qed.

Lemma ins_notnil: forall xs (i : nat) y (ys : seq X),
  ~ ins i (y :: ys) xs = Some (Nil _).
Proof. by move=> [|x xs] [|n] y ys //= /wcons_some; case => _ [] //. Qed.

Lemma ins_none' (es : seq X) k xs: ins (size xs + k.+1) es xs = None.
Proof. move: xs. by elim => [|x xs] //= ->. Qed.

Lemma ins_noneP k xs es: reflect (ins k es xs = None) (size xs < k).
elim: xs k => [|x xs IHx] [|k] /=; rewrite ?cats0; try by constructor.
case A0: (_ < k.+1); first by move: A0; rewrite ltnS => /IHx -> /=; constructor.
case A1: ins; first by constructor. move /IHx in A1.
by move: A0 A1; rewrite ltnS => ->. Qed.

(* Seems unnecessary, should we remove? *)
Lemma ins_some: forall xs es ys i,
  ins i es xs = Some ys -> size ys = size xs + size es /\ size xs >= i.
Proof. split. elim: xs es ys i H => [|x xs IHxs] es ys.
 + by case => [] //= [] <-; rewrite cats0 add0n.
 + case => [] /=.
   * by case => <-; rewrite size_cat /= addnC.
   * by move => n /wcons_some [] ? [] /IHxs A0 ->; rewrite /= A0.
 move: H. move/orP: (leq_total i (size xs)) => [] //; rewrite leq_eqVlt => /orP [].
 + by move /eqP -> => //.
 + by case: (ins_noneP i xs es) => // ->. Qed.

Lemma ins_id xs ys i:
 ins i [::] xs = Some ys -> xs = ys.
Proof.
by elim: i xs ys => [|i Hi] [|x xs] ys // [] //= /wcons_some [ys'] [] /Hi ->. Qed.

Lemma oins_Swcons (x : X) (es : seq X): forall xs i,
  oins (i.+1) es (x :~: xs) = x :~: oins i es xs.
Proof. by case => [] [] //=. Qed.

(* Remove list opertaion and its properties*)

Fixpoint rm
 i (es : seq X) (xs : seq X) :=
 match xs, es with
 | _, [::] => Some xs
 | [::], _ => None
 | x' :: xs', e' :: es' =>
   match i with
     | 0 => if x' == e' then rm 0 es' xs' else None
     | i'.+1 => x' :~: (rm i' es xs')
   end
 end.

Definition orm (index : nat) (elements : seq X) :=
 bind (rm index elements).

Lemma orm_some n es xs: rm n es xs = orm n es (Some xs).
Proof. done. Qed.

Lemma rm_id k xs: rm k [::] xs = Some xs.
Proof. by case: xs => [|x xs] /=. Qed.

Lemma rm_len i es xs rs:
  size es > 0 -> rm i es xs = Some rs -> exists k, size xs = i + (size es) + k /\ size rs = i + k.
Proof. elim: i es xs rs => [|i IHi] es xs rs H.
move {H}. elim: es xs rs => [|e es IHes] xs rs //=.
 + rewrite rm_id => [] [] ->. by exists (size rs).
 + case: xs => [|??] //=. case: eqP => // _ /IHes [k'] [].
   rewrite ?add0n => -> ->. by exists k'.
 + move: es H => [|??] //.
   case: xs => [|??] // /IHi => A /= /wcons_some [?] [] /A [k'] [] -> B -> /=.
   rewrite B ?addnS ?addSn. by exists k'.
Qed.

Corollary orm_id k xs : orm k [::] xs = xs.
Proof. by case : xs => [xs|] /=; rewrite ?rm_id. Qed.

Lemma orm_0wcons x es xs:
  orm 0 (x :: es) (x :~: xs) = orm 0 es xs.
Proof. by case: xs => //= => xs; rewrite eq_refl; case: xs => //=. Qed.

Lemma rm_0app: forall xs1 xs2 es,
  rm 0 (xs1 ++ es) (xs1 ++ xs2) = rm 0 es xs2.
Proof. by elim => [|x1 xs1 IHxs1] xs2 es //=; rewrite eq_refl IHxs1. Qed.

Lemma rm_Scons xs x k es:
  rm k.+1 es (x :: xs) = x :~: (rm k es xs).
Proof. case: es xs => [] //= [] //=. Qed.

Lemma orm_Swcons xs x k es:
  orm (k .+1) es (x :~: xs) = x :~: (orm k es xs).
Proof. elim: es xs => [|e es IHs] [[]|] //=.  Qed.

Lemma rm_addnapp xs ys k es:
  rm (k + size(ys)) es (ys ++ xs) = ys :++: (rm k es xs).
Proof. elim: ys xs es => [|y ys IHys] xs es //=.
  + by rewrite addn0 weak_app_0s.
  + move: es => [|e es] //=; first by rewrite ?rm_id.
    by rewrite addnS IHys; case: rm => [mr|]. Qed.

Lemma rm_none0 k xs e es: size xs <= k -> rm k (e :: es) xs = None.
Proof. by elim: xs k => [k //=|x xs IHl [|k] //= /IHl ->]. Qed.

Lemma rm_none1 {k xs es}: size es > 0 -> size xs < (size es) + k -> rm k es xs = None.
Proof. elim: xs k es => [|x xs IHxs] [|k] [|e es] // Heq /=; case: (x == e) => //;
rewrite ?addn0 ?addnS; try move=> /(IHxs _ _ Heq) -> // /(ltn_trans _ (ltnSn _)).
case Hes: (size es == 0); first by move/eqP: Hes ->. move /neq0_lt0n in Hes.
by rewrite -(addn0 (size es)) => /(IHxs _ _ Hes). Qed.

Lemma rm_eq (l1 l2 l3 : seq X): rm 0 l2 l1 = Some l3 -> l2 ++ l3 = l1.
elim: l2 l1 => [|a2 l2 IHl] [|a1 l1] //=; try by case => <-.
 + case A0: (a1 == a2) => // /IHl. by move: A0 => /eqP -> ->. Qed.

(* nth element operation and its properties *)
Fixpoint nth index xs : option X :=
 match xs, index with
   nil, _ => None
   | x :: xs, 0 => Some x
   | x :: xs, S i => nth i xs
 end.

Lemma nth_noneP i xs: reflect (nth i xs = None) (size xs <= i).
elim: xs i => [|x xs IHx] [|i] /=; try by constructor. apply IHx. Qed.

Lemma nth_nil_none (i : nat) (xs : seq X): nth i [::] = None.
Proof. move: (leq0n i). by rewrite -[0]/(size (@nil X)) => /nth_noneP. Qed.

Lemma nth_app_next xs1 xs2 k: nth (size xs1 + k) (xs1 ++ xs2) = nth k xs2.
Proof. elim: xs1 k xs2 => [|x1 xs1 IHxs1] k xs2 //=. Qed.

(* replace operation for lists and its properties *)

Fixpoint rplc (n : nat) (e : option X) (xs : seq X) :=
match n, xs with
 | 0, x :: xs' => bind (fun e' => Some (e' :: xs')) e
 | S n', x :: xs' => x :~: rplc n' e xs'
 | _, _ => None
end.

Definition orplc (index : nat) (e : option X) := bind (rplc index e).

Lemma orplc_some n e xs: rplc n e xs = orplc n e (Some xs).
Proof. done. Qed.

Lemma orplc_ind (x : X) l e i: orplc (S i) e (x :~: l)  = x :~: (orplc i e l).
Proof. by case l. Qed.

Lemma rplc_0 xs i (e : option X): rplc i e xs = Some [::] -> False.
Proof. by move: xs i e => [|??] [|?] [?|] //=; case: rplc. Qed.

Lemma rplc_0none i e: rplc i e [::] = None.
Proof. by case: i e => [|i] [e|]. Qed.

Lemma rplc_noneP1 (e : X) {k} {xs}: reflect (rplc k (Some e) xs = None) (size xs <= k).
elim: xs k => [|x xs IHx] [|k] /=; try by constructor. rewrite ltnS.
by case: (rplc k (Some e) xs) (IHx k) => [a|]; case leq => [] [] //; constructor. Qed.

Lemma rplc_none_none k xs: rplc k None xs = None.
Proof. by elim: xs k => [|x xs Hxs] [|k] //=; rewrite Hxs. Qed.

Lemma rplc_lenle k xs (e : option X): size xs <= k -> rplc k e xs = None.
case: e => [a /(rplc_noneP1 a) //|] ?. by rewrite rplc_none_none. Qed.

Lemma rplc_none_case k xs (e : option X): rplc k e xs = None <-> e = None \/ size xs <= k.
Proof. case: e => [a|]; rewrite ?rplc_none_none; split;
 try move=> []; try move /rplc_noneP1; try done; by [right| left]. Qed.

Lemma rplc_some k xs (e : option X) y: rplc k e xs = Some y
-> k < size xs /\ (exists e',  e = Some e').
Proof. case: e => [e'|]; last by rewrite rplc_none_none.
case Hsz: (k < size xs); last by move: Hsz => /negbT; rewrite -leqNgt =>
/(rplc_lenle _ _ (Some e')) ->. by split => //; exists e'. Qed.

Lemma rplc_Scons xs i (x : X) y: rplc (i.+1) y (x :: xs) = x :~: (rplc i y xs).
Proof. done. Qed.

Lemma orplc_0wcons xs (x : X) y: orplc 0 (Some y) (x :~: xs) = y :~: xs.
Proof. by case: xs. Qed.

Lemma rplc_addn_app xs1 xs2 k e:
  rplc (size xs1 + k) e (xs1 ++ xs2) = xs1 :++: rplc k e xs2.
Proof. case: e => [e|]; last by rewrite ?rplc_none_none.
 by elim: xs1 => [|x1 xs1 IHxs1]; rewrite ?cat0s ?add0n //= ?IHxs1 //=; case: rplc. Qed.

Lemma orplc_Swcons xs i (x : X) y: orplc (i.+1) y (x :~: xs) = x :~: (orplc i y xs).
Proof. case: xs; done. Qed.

Lemma rplc_some_len (xs ys : seq X) i e: rplc i e xs = Some ys -> size xs = size ys.
Proof. case: e => [e|]; rewrite ?rplc_none_none //;
 elim: i xs ys => [|i IHi] [|x xs] //= ys; first by move=> //= [] <-.
 by move /wcons_some => [xs'] [] /IHi -> ->. Qed.

Lemma orplc_none i l: orplc i None l = None.
elim: i l => [|n IHn] [[|a l]|] //=. by move: (IHn (Some l)) => /= ->. Qed.

(* replace and nth propertice *)
Lemma rplc_nth_id (xs ys: seq X) i: rplc i (nth i xs) xs = Some ys -> xs = ys.
Proof. elim: i xs ys => [|i Hi] [|x xs] ys //= []; first by move ->.
  by move /wcons_some => [xs'] [] /Hi -> ->. Qed.

Lemma rplc_nth_id' i xs y: nth i xs = Some y -> rplc i (nth i xs) xs = Some xs.
Proof. by elim: i y xs => [|i IHi] y [|x xs] //= /IHi ->. Qed.

(* cut operation and its properties *)
Fixpoint cut {X} (l : seq.seq X ) sc rc :=
match sc, rc, l with
 | S sc', _, x :: xs => x :: (cut xs sc' rc)
 | 0, S rc', x :: xs => (cut xs sc rc')
 | _, _, _ => l
end.

Lemma cut_id {xs : seq X} {n}: cut xs n 0 = xs.
Proof. by elim: xs n => [|x xs IHxs] [|n] //=; rewrite IHxs. Qed.

Lemma cut_empty_eq {Y : Type}: forall n k, cut (@nil Y) n k = @nil Y.
Proof. by move=> [|n] [|k]. Qed.

Lemma cut_nil {Y : Type}: forall xs, cut xs 0 (size xs) = @nil Y.
Proof. by elim. Qed.

(* insert/insert commutation *)
Lemma ins_insC': forall xs i k (e1s e2s : seq X), (i + k) <= size xs ->
oins (size e1s + (i + k)) e2s (ins i e1s xs) = oins i e1s (ins (i + k) e2s xs)
/\ exists os, oins i e1s (ins (i + k) e2s xs) = Some os.
Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1s e2s. rewrite add0n /=.
 + elim: e1s => [|e1 e1s IHx] Hsz /=. rewrite add0n.
   case Hins: (ins k) => [a|] /=; split => //; first by exists a.
   by move: Hins Hsz => /ins_noneP; rewrite ltnNge; case leq.
 + move: (Hsz) => /IHx => [] [] IHx' IHx''.
   case Hins: (ins k) => [a|] /=; split => //; try by rewrite IHx' Hins /=.
   by exists (e1 :: e1s ++ a).
   by move: Hins Hsz => /ins_noneP; rewrite ltnNge; case leq.
 + case: xs => [|x xs] //=. rewrite addSn addnS => /IHi /= A.
   move: (A e1s e2s) => []. rewrite ?oins_Swcons => -> [os] ->.
   split => //=. by exists (x :: os).
Qed.

Theorem ins_insC: forall xs i k (e1s e2s : seq X), i <= k -> k <= size xs ->
oins (size e1s + k) e2s (ins i e1s xs) = oins i e1s (ins k e2s xs)
/\ exists os, oins i e1s (ins k e2s xs) = Some os.
Proof. move=> xs i k e1s e2s /le_ex [j] <-. exact: ins_insC'. Qed.

(* remove/remove commutation *)
Lemma rm_rmC': forall xs i k (e1s e2s : seq X) rrm1 rrm2,
rm ((size e2s) + i + k) e1s xs = Some rrm1 ->
rm i e2s xs = Some rrm2 ->
orm i e2s (rm ((size e2s) + i + k) e1s xs) = orm (i + k) e1s (rm i e2s xs)
/\ exists os, orm (i + k) e1s (rm i e2s xs) = Some os.
Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1s e2s rrm1 rrm2.
 + rewrite add0n /=. elim: e2s xs e1s rrm1 rrm2 => [|e2 e2s IHe2s] [|x?] [|??] rrm1 rrm2; try by eauto.
   rewrite /= ?add0n. case: k => [|k]; rewrite orm_id => ->; by eauto.
   rewrite /= orm_id => _ ->; by eauto.
   simpl. case H: (x == e2) =>// /wcons_some [rrm1'] [] /IHe2s A _ /A [].
   move/eqP: H => ->. rewrite orm_0wcons => ->. by eauto.
 + rewrite addnS ?addSn //=.
   move: xs e1s => [|x xs] [|e1 e1s] //=; rewrite ?orm_id //=;
   try (move=> _ ->; by eauto).
   move=> /wcons_some [rrm1'] [] /IHi A _.
   case: e2s A => [|e2 e2s] A; [move: (rm_id i xs)| move=> /wcons_some [rrm2'] []];
   move=> /A; rewrite ?orm_id ?rm_id ?cons_wcons ?orm_Swcons => [] []-> [os] -> /=; by eauto.
Qed.

Theorem rm_rmC: forall xs i k (e1s e2s : seq X) rrm1 rrm2,
i <= k ->
rm ((size e2s) + k) e1s xs = Some rrm1 ->
rm i e2s xs = Some rrm2 ->
orm i e2s (rm ((size e2s) + k) e1s xs) = orm k e1s (rm i e2s xs)
/\ exists os, orm k e1s (rm i e2s xs) = Some os.
Proof. move=> xs i k e1s e2s rrm1 rrm2 /le_ex [j] <-. rewrite addnA.
move=> /rm_rmC' A /A []. by eauto.
Qed.

(* remove/insert commutation *)
Lemma rm_insC_bef': forall xs i k eis ers rins rrm,
oins ((size ers) + i + k) eis xs = Some rins ->
orm i ers xs = Some rrm ->
orm i ers (oins ((size ers) + i + k) eis xs) = oins (i+k) eis (orm i ers xs)
/\ exists os, oins (i+k) eis (orm i ers xs) = Some os.
Proof. case => [] // xs i. elim: i xs => [|i IHi] xs k eis ers. rewrite addn0 add0n /=.
 + elim: ers xs eis => [xs eis|er ers IHers [|x?] eis//=] rins rrm => /=.
   rewrite add0n orm_id rm_id; split => //. by exists rins; rewrite /= H.
   case H: (x == er).
  - move/eqP: H; move=> -> //= /wcons_some [rins'] [] /IHers A _ /A [].
    by rewrite orm_0wcons => ->.
  - by case: ins => [res|].
 + move=> rins rrm; rewrite addnS addSn //=.
   move: xs => [|x xs] //=. move: ers => [|er ers].
  - rewrite orm_id /= => ->. split => //. by exists  rins.
   rewrite addSn orm_Swcons oins_Swcons oins_some => /wcons_some [rins'] [] /IHi A _
   /wcons_some [rrm'] []. rewrite orm_some => /A [] -> [os] -> /=; split => //. by exists (x :: os). Qed.

Theorem rm_insC_bef xs i k eis ers rins rrm:
i <= k ->
oins ((size ers) + k) eis xs = Some rins ->
orm i ers xs = Some rrm ->
orm i ers (oins ((size ers) + k) eis xs) = oins k eis (orm i ers xs)
/\ exists os, oins k eis (orm i ers xs) = Some os.
Proof. move=> /le_ex [?] <-. by rewrite addnA => /rm_insC_bef' A /A. Qed.

Lemma rm_insC_aft': forall i xs k eis ers rins rrm,
ins i eis xs = Some rins -> rm (i + k) ers xs = Some rrm ->
 orm ((size eis) + (i + k)) ers (ins i eis xs) = oins i eis (rm (i + k) ers xs)
  /\ exists os, oins i eis (rm (i + k) ers xs) = Some os.
Proof.
by elim => [|i IHi] xs k eis ers rins rrm //=;
 [rewrite add0n /= {1}addnC rm_addnapp; case: rm => [mr|]|
  move: xs ers => [|??] [|??] //=;
  [case H: ins => [?|] //|
   rewrite ?addSn addnS orm_Swcons oins_Swcons =>
   /wcons_some [?] [] /IHi A ? /wcons_some [?] [] /A [] <- [?] ->]];
   split => //=; eauto. Qed.

Lemma rm_insC_aft xs i k eis ers rins rrm:
i <= k -> ins i eis xs = Some rins -> rm k ers xs = Some rrm ->
 orm ((size eis) + k) ers (ins i eis xs) = oins i eis (rm k ers xs)
  /\ exists os, oins i eis (rm k ers xs) = Some os.
Proof. by move=> /le_ex [?] <- /rm_insC_aft' A /A [] ->. Qed.

Lemma rm_insC_in': forall i k xs eis ers ers' xs',
ins k eis ers = Some ers' -> ins (i+k) eis xs = Some xs' ->
  rm i ers xs = rm i ers' xs'.
Proof. elim => [|i Hi].
 +  elim => [|k Hk] [|x?] eis [|er?] ?? //=;
  try (by move=> [] <- [] <-; rewrite rm_0app).
  * move => /wcons_some [?] [] => H1 -> /wcons_some [?] [] => H2 -> /=.
    case: (x == er) H1 H2 => //. by apply /Hk.
 + by move => ? [|??] ? [|??] ? ? //= H1 /wcons_some [?] [H2 ->];
   rewrite rm_Scons -(Hi _ _ _ _ _ _ H1 H2) // ?rm_id. Qed.

Theorem rm_insC_in i k xs eis ers ers' xs':
i <= k -> ins (k - i) eis ers = Some ers' ->
 ins k eis xs = Some xs' ->
  rm i ers xs = rm i ers' xs'.
Proof. move=> /le_ex [s] <-;
rewrite addnC -addnBA // subnn addn0 addnC => *.
by apply (rm_insC_in' _ s _ eis). Qed.

(* replace/replace commutation *)
Lemma rplc_rplcC_neq': forall l i k t1 t2,
orplc (S (i + k)) t2 (orplc i t1 l) = orplc i t1 (orplc ((S i + k)) t2 l).
Proof. case => //. elim => [|x xs IHx]; intros. by rewrite /orplc /= rplc_0none.
case: t1 t2 => [t1|] [t2|]; try by rewrite ?orplc_none.
case: i => [/=|i]; first by case: rplc => [].
by rewrite ?addSn ?orplc_ind IHx. Qed.

Theorem rplc_rplcC_neq: forall l i k t1 t2, i == k = false ->
orplc k t2 (orplc i t1 l) = orplc i t1 (orplc k t2 l).
Proof. intros. case Hik: (i < k).
 + by move: Hik => /le_ex [j] <-; rewrite addSn rplc_rplcC_neq'.
 + case Hik': (k < i).
  - by move: Hik' => /le_ex [j] <-; rewrite addSn rplc_rplcC_neq'.
  - by move: Hik => /negbT; rewrite -leqNgt; move: Hik' => /negbT; rewrite -leqNgt => A B;
    have H': (i <= k <= i); rewrite ?B ?A //; move: H'; rewrite -eqn_leq H.
Qed.

Lemma rplc_rplcC_eq: forall xs i e1 e2,
orplc i e2 (orplc i (Some e1) xs) = orplc i e2 xs.
Proof. case=> [xs|] // i; elim: i xs => [|i IHi] xs e1 e2; first by case: xs.
 by case: xs IHi => [|x xs] IHi //=; rewrite orplc_Swcons IHi.
Qed.

(* replace/insert commutation *)

Lemma rplc_insC_aft': forall xs i k e1 e2s, i + k < size xs ->
orplc (size e2s + (i + k)) (Some e1) (ins i e2s xs) = oins i e2s (rplc (i + k) (Some e1) xs)
/\ exists os, oins i e2s (rplc (i + k) (Some e1) xs) = Some os.
Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1 e2s.
 + rewrite add0n /= rplc_addn_app; case Hrplc: rplc => [rplc_r|] /=;
   first by (split => //; by exists (e2s ++ rplc_r)). move: Hrplc => /rplc_noneP1. by rewrite ltnNge; case leq.
 + rewrite ?addSn ?addnS. case: xs => [|x xs] //=.
   rewrite ?orplc_Swcons oins_Swcons => /IHi A. move: (A e1 e2s) => [] <- [os] ->.
   split=> //. by exists (x :: os).
Qed.

Theorem rplc_insC_aft: forall xs i k e1 e2s, i <= k -> k < size xs ->
orplc (size e2s + k) (Some e1) (ins i e2s xs) = oins i e2s (rplc k (Some e1) xs)
/\ exists os, oins i e2s (rplc k (Some e1) xs) = Some os.
Proof. move=> ??? e1 e2s /le_ex [?] <- /rplc_insC_aft' A. move: (A e1 e2s) => [] -> [os] ->.
 split=> //. by eauto.
Qed.

Lemma rplc_insC_bef': forall xs i k e1 e2s, i + (S k) <= size xs ->
orplc i (Some e1) (ins (S (i + k)) e2s xs) = oins (S (i + k)) e2s  (rplc i (Some e1) xs)
/\ exists os, orplc i (Some e1) (ins (S (i + k)) e2s xs) = Some os.
Proof. move=>  xs i. elim: i xs => [|i IHi].
 + case=> [|x xs] k e1 e2s; rewrite add0n ?rplc_none_none //=; case Hins: ins => [ins_r|] //=.
  - split => //. by exists (e1 :: ins_r).
  - by move: Hins => /ins_noneP; rewrite ltnNge add0n -ltnS; case (_ <= _).
 + case=> [|x xs] k e1 e2s //. rewrite addSn /= => /IHi A. move: (A e1 e2s) => [] /=.
   rewrite orplc_Swcons oins_Swcons => -> [os] ->. split => //. by exists (x :: os).
Qed.

Theorem rplc_insC_bef: forall xs i k e1 e2s, i < k -> k <= size xs ->
orplc i (Some e1) (ins k e2s xs) = oins k e2s  (rplc i (Some e1) xs)
/\ exists os, orplc i (Some e1) (ins k e2s xs) = Some os.
Proof. move=> ??? e1 e2s /le_ex [?] <-.  rewrite ?addSn -?addnS => /rplc_insC_bef' A.
move: (A e1 e2s) => []. rewrite addnS=> -> [os] ->. split=> //. by exists os.  Qed.

Lemma rplc_insC_in: forall xs i k e1 e2s e2s',
rplc k (Some e1) e2s = Some e2s' -> orplc (i + k) (Some e1) (ins i e2s xs) = ins i e2s' xs.
Proof. intros. elim: i xs k e1 e2s e2s' H => [|i IHi].
 + move=> xs k e1 e2s e2s'; rewrite add0n //=.
   elim: k xs e1 e2s e2s' => [|k IHk] xs e1 e2s e2s'; case: e2s => [|e2 e2s] //; rewrite cat_cons //=.
  * by move=> [] [] <-; rewrite cat_cons.
  * by move=> /wcons_some [e2s''] [] /(IHk xs) -> ->.
 + by move=> [|x xs] k e1 e2s e2s' //=; rewrite addSn orplc_Swcons => /(IHi xs) ->.
Qed.

(* replace/remove commutation *)

Lemma rplc_rmC_aft' xs i k e1 e2s rrm:
 rm i e2s xs = Some rrm -> (size e2s + i + k) < size xs ->
  orplc (i+k) (Some e1) (rm i e2s xs) =
  orm i e2s (rplc (size e2s + i + k) (Some e1) xs)
   /\ exists os, orplc (i+k) (Some e1) (rm i e2s xs) = Some os.
Proof. elim: i xs k e1 e2s rrm => [|i IHi] xs k e1 e2s rrm.
 + rewrite ?addn0 add0n. elim: e2s k xs e1 => [[|k]|e2 e2s IHe2s k] [|x xs] e1;
   rewrite ?addn0 ?orm_id ?rm_id /=; try by eauto.
  - move=> _. rewrite add0n. case Hrplc: rplc => [a|] /=. by eauto.
    move: Hrplc => /rplc_noneP1. by rewrite ltnNge ltnS => ->.
   case Heq: (x == e2) => //. move/eqP: Heq <-. rewrite orm_0wcons addSn => H1.
   move: H1. eapply IHe2s => /(_ e1) /= [] -> [os] ->.
 + rewrite ?addSn ?addnS; move: xs IHi => [|x xs IHi]; first by case: e2s.
   rewrite rm_Scons orplc_Swcons => /wcons_some [rrm'] []. swap => _. swap.
   rewrite addSn rplc_Scons orm_Swcons => /=. swap.
   maxapply IHi => /(_ e1) [] -> [os] -> /=. by eauto.
Qed.

Theorem rplc_rmC_aft xs i k e1 e2s rrm: i <= k ->
 rm i e2s xs = Some rrm -> size e2s + k < size xs ->
   orplc k (Some e1) (rm i e2s xs) =
   orm i e2s (rplc (size e2s + k) (Some e1) xs)
    /\ exists os, orplc k (Some e1) (rm i e2s xs) = Some os.
Proof. move => /le_ex [?] <-. rewrite ?addnA.
apply rplc_rmC_aft' => /(_ e1) [] -> [os] -> /=. Qed.

Lemma rplc_rmC_bef': forall i xs k e1 e2s rrm,
 rm (S (i+k)) e2s xs = Some rrm -> i < size xs ->
  orplc i (Some e1) (rm (S (i+k)) e2s xs) =
  orm (S (i+k)) e2s (rplc i (Some e1) xs)
   /\ exists os, orplc i (Some e1) (rm (S (i+k)) e2s xs) = Some os.
Proof. elim => [|i IHi] xs k e1 e2s rrm.
 + rewrite add0n; elim: e2s xs k e1 => [|er e2s IHe2s] xs k e1 /=.
  * rewrite rm_id => _ /=. case: xs => [|x xs] //= _ . by eauto.
  * case: xs => [|x xs] //=; rewrite orplc_0wcons => /wcons_some [rrm'] [] -> /=. by eauto.
 + rewrite ?addSn ?addnS. case: xs => [|x xs] //=.
   case: e2s => [|e2 e2s] /=.
  - move=> _. case Hrplc: rplc => [rplc_r|] /=; first by eauto.
     by move: Hrplc => /rplc_noneP1; rewrite ltnNge ltnS => ->.
  - move => /wcons_some [rrm'] []. swap => _.
    rewrite orplc_Swcons ?orm_Swcons. maxapply IHi => /(_ e1) [] -> [os] -> /=. by eauto. Qed.

Theorem rplc_rmC_bef xs i k e1 e2s rrm:
 i < k -> rm k e2s xs = Some rrm -> i < size xs ->
  orplc i (Some e1) (orm k e2s (Some xs)) =
  orm k e2s (rplc i (Some e1) xs)
   /\ exists os, orplc i (Some e1) (rm k e2s xs) = Some os.
Proof. move=> /le_ex [?] <-; rewrite ?addSn.
by apply rplc_rmC_bef' => /(_ e1) [] -> ? ->. Qed.

Theorem rplc_rmC_in {xs i k y}: forall ys ers' ers,
 rplc i y ers = Some ers' -> orm k ers xs = Some ys ->
  orm k ers' (orplc (i + k) y xs) = Some ys.
Proof. case: xs i k y => [xs|*//]; intros. case: y H => [y|] //=; last by rewrite rplc_none_none.
  elim: k xs i y ys ers ers' H0 => [|k IHk].
 + move=> xs i; elim: i xs => [|i IHi] xs y ys [|er ers] ers' //=; case: xs => [|x xs] //=;
   case Heq: (x == er) => // ?; first by move=> [] <-; rewrite eq_refl.
   by move=> /wcons_some [ers''] [] ? ->; move/eqP: Heq ->;
   rewrite orm_0wcons (IHi xs y ys ers ers'').
 + by move=> [|x xs] i y ys [|er ers] ers'; rewrite ?addnS ?rplc_0none //= orm_Swcons =>
   /wcons_some [ys' []] ? -> ?; rewrite (IHk _ _ _ ys' (er::ers)). Qed.

(* relating other operations to nth *)
Lemma ins_some_nth_aft {n ys}: forall xs es n2, n < n2 -> ins n2 es xs = Some ys
-> nth n ys = nth n xs.
Proof. elim: n ys => [|n IHn] ys [|x xs] [|e es] [|n2] //= Hltn /wcons_some [ys'] [] Hys' -> //=;
  by rewrite (IHn _ xs _ n2 _ Hys')//. Qed.

Lemma rm_some_nth_aft: forall n xs ys es n2, n < n2 -> rm n2 es xs = Some ys
-> nth n ys = nth n xs.
Proof. elim => [|n IHn] [|x xs] ys [|e es] [|n2] //= Hltn; try move=> [] <- //=;
 move=> /wcons_some [ys'] [] Hys' -> //; rewrite (IHn xs _ _ n2 _ Hys') //.
Qed.

Lemma rm_some_nth_bef: forall n xs ys es n2, n <= n2 -> rm n es xs = Some ys
-> nth n2 ys = nth (n2 + size es) xs.
Proof. elim => [|n IHn] xs ys es n2.
+ move=> H; elim: xs es => [|x xs IHxs] [[] <- //|e es] //=; try by rewrite addn0.
  by case Heq: (x == e) => // /IHxs ->; rewrite addnS.
+ case: es => [|e es]; first by rewrite rm_id addn0 => _ [] ->.
  by case: xs => [|x xs] //= Hleq /wcons_some [ys'] [] ? ->; case: n2 Hleq => [|n2] // /= ?;
  rewrite (IHn xs _ (e::es)) //. Qed.

Lemma rm_some_nth_in {k i xs}: forall ys es, i < size es -> rm k es xs = Some ys ->
nth (i + k) xs = nth i es.
Proof. by elim: k i xs => [|k IHk i]; [elim => [|i IHi] /=|]; move => [|x xs] ys [|e es] //=;
 [| |(rewrite addnS ?nth_nil_none //= => ? /wcons_some [ys'] [] ?; rewrite (IHk _ _ ys' (e::es)))];
 case Heq: (x == e) => //; [move /eqP: Heq => <- | move => ??; rewrite (IHi _ ys es)]. Qed.

Lemma ins_some_nth_bef {n xs}: forall ys es n2, n2 <= n -> ins n2 es xs = Some ys
-> nth n xs = nth (size es + n) ys.
Proof. elim: n xs => [|n IHn] xs ys es n2.
 + by rewrite leqn0 => /eqP -> /= [] <-; rewrite nth_app_next.
 + case: n2 => [_|n2] /=. by move=> [] <-; rewrite nth_app_next.
   by case: xs => [|x xs] // ? /wcons_some [ls'] [] ?;
      rewrite addnS (IHn _ ls' es n2) //= => ->.
Qed.

Lemma ins_some_nth_in {i k es ys xs} : k < size es -> ins i es xs = Some ys -> nth (i + k) ys = nth k es.
Proof. elim: i xs ys => [|i IHi] xs ys.
 + move=> H /= [] <-; rewrite add0n. elim: k es H => [|k IHk] [|e es] //=.
   by move /IHk.
 + by case: xs => [|x xs] //= Hlt /wcons_some [zs] [] /(IHi xs zs Hlt) <- ->.
Qed.

Lemma rplc_nth_eq n xs ys z: rplc n (Some z) xs = Some ys -> nth n ys = Some z.
Proof. elim: n xs ys => [|n IHn] [|x xs] [|y ys] //=.
 - by move=> [] ->.
 - by case: rplc.
 - by case Hrplc: rplc => [ls|] //= []; move: Hrplc => /IHn /= <- _ ->. Qed.

Lemma rplc_nth_neq' n1 n2 xs ys z: n1 < n2 ->
rplc n1 z xs = Some ys -> nth n2 xs = nth n2 ys.
Proof. case: z => [z|] //; last by rewrite rplc_none_none.
elim: n1 xs ys n2 => [|n1 IHn1] [|x xs] ys n2 //=; case: n2 => [|n2] //= ?.
 + by move => [] <-.
 + by move => /wcons_some [ys'] [] ? ->; rewrite (IHn1 _ ys'). Qed.

Lemma rplc_nth_neq'' n1 n2 xs ys z: n1 < n2 ->
rplc n2 z xs = Some ys -> nth n1 xs = nth n1 ys.
Proof. case: z => [z|] //; last by rewrite rplc_none_none.
elim: n2 xs ys n1 => [|n2 IHn2] [|x xs] ys [|n1] //= ? /wcons_some [ys'[? ->]] //.
by apply (IHn2 _ ys'). Qed.

Theorem rplc_nth_neq n1 n2 xs ys z: n1 != n2 ->
rplc n2 z xs = Some ys -> nth n1 xs = nth n1 ys.
Proof. rewrite neq_ltn => /orP []; [exact: rplc_nth_neq'' |exact: rplc_nth_neq']. Qed.

(* remove/cut properties *)

Lemma rm_cut : forall xs n1 n2 es1 es2 ys1 ys2,
 orm n1 es1 xs = Some ys1 -> orm n2 es2 xs = Some ys2 -> n1 <= n2 -> n2 <= n1 + size es1 ->
 orm n1 (cut es2 0 (n1 + size es1 - n2)) (orm n1 es1 xs) =
 orm n1 (cut es1 (n2 - n1) (size es2)) (orm n2 es2 xs) /\
 exists os, orm n1 (cut es1 (n2 - n1) (size es2)) (orm n2 es2 xs) = Some os.
Proof. move=> [xs|] n1 //; elim: n1 xs => [|n1 IHn1].
 + elim => [|x xs IHxs].
  - move=> n2 [|??] [|??] //= [|??] [|??] //= _ _ _.
    rewrite leqn0 => /eqP ->. rewrite subnn. by eauto.
  - move=> n2 [|e1 es1] [|e2 es2] ys1 ys2 /= H1 H2 H3;
     try (rewrite leqn0 => /eqP Hn2; move: H2; rewrite Hn2 subnn ?orm_id;
          case: (x == e2); by eauto).
   * case: n2 H2 H3 => [|n2] //. by eauto.
     case: n2 H3 => [|n2] // _ _; rewrite add0n ?subn0; try case: subn => [|?];
     move: H1; case: (x == e1) => //; rewrite ?cut_id orm_id => ->; by eauto.
   * move: H1. case Heq: (x == e1) => // /IHxs A.
     move: H2. case: n2 H3 => [|n2] _.
    - case: (x == e2) => // /A B. move: (B (leq0n _) (leq0n _)) => /=.
      rewrite add0n ?subn0 => [] [] -> [os] ->; by eauto.
    - move => /wcons_some [ys2'] [] /A B _. rewrite add0n => /(B (leq0n _)) /= [].
      rewrite subn0 => ->. move/eqP: Heq ->. rewrite orm_0wcons => [] [os] ->. by eauto.
 + move=> [|x xs] [|n2] es1 es2 ys1 ys2 //; rewrite ?cons_wcons ?orm_Swcons subSS.
  - move: es1 es2 => [|??] [|??] //=; case: subn; case: subn => //=; by eauto.
   move=> /wcons_some [ys1'] [] /IHn1 A _ /wcons_some [ys2'] [] /A B _ /B C.
   rewrite addSn. move => /C [] -> [os] -> /=. by eauto.
Qed.

(* inversion theorems *)
Lemma rm_ins_id : forall n xs es ys,
ins n es xs = Some ys -> rm n es ys = Some xs.
Proof. elim => [|n IHn] xs es ys.
 + elim: es xs ys => [[|x xs]|e es IHes xs] ys //= [] <-; try (by rewrite rm_id).
   rewrite orm_some cons_wcons orm_0wcons /= (IHes xs) //.
 + case: xs => [|x xs] //. rewrite oins_some cons_wcons oins_Swcons => /wcons_some [ys'] [].
   move=> /IHn <- ->. by rewrite orm_some cons_wcons orm_Swcons.
Qed.

Lemma ins_rm_id : forall n xs es ys,
size es > 0 -> rm n es xs = Some ys -> ins n es ys = Some xs.
Proof. elim => [|n IHn] xs es ys.
 + move=> _. elim: es xs ys => [|e es IHes] [|x xs] ys //=; try (by rewrite rm_id => -> /=).
   case Heq: (x == e) => // /IHes [] <-. by move/eqP: Heq ->.
 + case: xs => [|x xs] //. case: es => //= [] [] <-. swap. rewrite orm_some cons_wcons orm_Swcons.
   move=> /wcons_some => [] [ys'] []. swap => -> /=. maxapply IHn. by move=> /= ->.
Qed.

Section AboutSizes.

Theorem cutSZ (xs : seq X) i n:
size (cut xs i n) =
 if (i + n <= size xs) then size xs - n
 else if (i <= size xs) then i
 else size xs.
Proof. elim: i xs n => [|i IHi] xs n /=.
 + elim: n xs => [|n IHn] [|x xs] //=. rewrite IHn. nat_norm.
   rewrite -addn1 -(addn1 (size xs)) leq_add2r. case Hleq: (n <= size xs) => //=.
   by rewrite ?addn1 subSS.
 + move: xs => [|x xs] //=. rewrite IHi. nat_norm.
   rewrite -(addn1 (i + n)) -(addn1 (size xs)) leq_add2r. case Hleq: (i + n <= size xs).
   move: (Hleq) => /leq_addWl. rewrite -addn1 addnC => /addnBA ->. by rewrite addnC.
   rewrite -(addn1 i) leq_add2r. case: (i <= size xs); ssromega.
Qed.

Theorem cut_lenleq (xs : seq X) i n:
size (cut xs i n) <= size xs.
Proof. move: (cutSZ xs i n). case: ifP => Hleq.
 - move: (leq_subr n (size xs)). by swap => ->.
 - case: ifP => Hleq'; move=> /eq_leq =>//.
   move: Hleq'. swap. by apply leq_trans. Qed.

End AboutSizes.

Section Miscellanea.

Fixpoint find {Z : Type} p (xs : seq Z) : option Z :=
 match xs with
 | xh :: xt => if p xh then Some xh else find p xt
 | _ => None end.

Lemma foldl_map (T1 T2 S : Type) (f : S -> T2 -> S) (g : T1 -> T2) (x : seq T1) (r : S):
foldl f r (map g x) = foldl (fun x => (f x) \o g) r x.
by elim: x r => [|x xs IH] //=. Qed.

Lemma filter_filter {p p' : X -> bool} {xs} : filter p (filter p' xs) = filter p' (filter p xs).
elim: xs => //= [xh xt IHxs]. case P1: (p xh); case P2: (p' xh);  rewrite /= ?P1 ?P2 IHxs //. Qed.

Lemma all_filter p q (cs :seq X): all p cs -> all p [seq x <- cs | q x].
by elim: cs => [|c cs IH] //= /andP [] A0 /IH A1; case A2: q => /=; rewrite ?A0 A1. Qed.

Lemma has_filter p q (xs : seq X): p --- q -> has q (filter p xs) = has q xs.
intros A1. elim: xs => [|x xs IH] //=. move: (A1 x). case A0: (p x).
 + by rewrite /= IH.
 + by move => -> //. Qed.

Lemma map_inj {X' : eqType} (f : X -> X') x s: injective f -> ((f x) \in (map f s)) = (x \in s).
move => B0. elim: s => [|c s IH] //=.
case A0: (x == c) => /=.
 + move: A0 => /eqP ->. by rewrite /in_mem /= ?eq_refl.
 + move: IH. rewrite /in_mem /=. case A1: eq_op.
  * move: A1 A0 => /eqP /B0 ->. by rewrite eq_refl.
  * by move: A0 => -> ->. Qed.

Lemma find_absent {A p xs}: find p xs = @None A <-> has p xs = false.
by elim: xs => // a l [IHa IHb] /=; case: (p a); split. Qed.

Lemma has_find {A p xs}: has p xs = true -> exists (x : A), find p xs = Some x.
case H: (find p xs) => [x|].
  + by exists x.
  + by move => G; apply find_absent in H; rewrite H in G. Qed.

Lemma find_pred {xs p} {x : X}: find p xs = Some x -> p x.
elim: xs => [|xh xt IHxs] //.
 + by rewrite /=; case H: (p xh) => // [] [] <-. Qed.

Lemma find_filter p q (xs : seq X): p --- q -> find q (filter p xs) = find q xs.
intros A1. elim: xs => [|x xs IH] //=. move: (A1 x). case A0: (p x).
 + by rewrite /= IH.
 + by move => -> //. Qed.

Lemma find_has {p xs} {x : X}: find p xs = Some x -> has p xs = true.
by elim: xs => [|xh xt IHxs]; rewrite //=; case P: (p xh) => //. Qed.

End Miscellanea.

(* Sequence difference *)

Definition seqminus (x y : seq X) := filter (fun z => z \notin y) x.

Section SeqMinus.

Notation "X \ Y" := (seqminus X Y) (at level 40, left associativity).

Lemma sum_setminus (f : X -> nat) (S1 S2 : seq X):
  foldl addn 0 (map f (S1 \ S2)) <= foldl addn 0 (map f S1).
elim: S1 S2 => [|s cs IH] S2 //=. case A0: (in_mem) => /=; move: (IH S2); rewrite ?add0n ?(fadd (f s)).
 + move: (foldl _ _ _) => a. move: (foldl _ _ _) => b. rewrite -{2}(add0n (a)). by apply leq_add.
 + by apply leq_add. Qed.

Lemma seqminus_nil (l : seq X): l \ [::] = l.
 elim: l => [|t l IH] //=. by rewrite IH. Qed.

Lemma seqminus_nil' (l : seq X): [::] \ l = [::].
 elim: l => [|t l IH] //=. Qed.

Lemma seqminus_cons (l l2 : seq X) x: x \notin l -> l \  (x :: l2) = l \ l2.
elim: l => [|y l IH] //=. rewrite /in_mem /= eq_sym. case A0: eq_op => //= A1. by rewrite IH. Qed.

Lemma seqminus_cons' (l l2 : seq X) x: x \notin l2 -> (x :: l) \ l2 = x :: (l \ l2).
by move => /= ->. Qed.

Corollary seqminus_singleton (l : seq X) x: x \notin l -> l \ [:: x] = l.
move: (seqminus_cons l [::] x). by rewrite /= seqminus_nil. Qed.

Import Bool.

Lemma notin_setminus (l : seq X) x: x \notin (l \ [::x]).
elim: l => [|z l IH] //=. case A0: (in_mem z) => //=. move: A0.
by rewrite /in_mem /= orb_false_r eq_sym => ->. Qed.

Corollary uniq_setminus (l l2 : seq X): uniq l -> uniq (l \ l2).
rewrite /seqminus. apply filter_uniq. Qed.

Lemma filter_and (l : seq X) p1 p2: filter p2 (filter p1 l) = filter (fun x => p1 x && p2 x) l.
elim: l => [|x l IH] //=. case A0: (p1 x) => //=.
 + case A1: (p2 x) => //=. by rewrite IH. Qed.

Lemma seqminus_cat (l l1 l2 : seq X): l \ l1 \ l2 = l \ (l1 ++ l2).
rewrite /seqminus. rewrite filter_and. apply eq_filter => x /=. by rewrite mem_cat /= negb_orb. Qed.

Lemma seqminus_p1 (l1 l2 : seq X) x: x \notin l2 -> l2 \ (l1 \ [:: x]) = l2 \ l1.
rewrite /seqminus => A0. apply eq_in_filter => z A1. rewrite mem_filter /= /in_mem /= orb_false_r.
case A2: eq_op => //=. by move: A2 A1 A0 => /eqP -> ->. Qed.

End SeqMinus.

End Lists.

Notation "X \ Y" := (seqminus X Y) (at level 40, left associativity).

Lemma map_seq_minus {X X' : eqType} (s1 s2 : seq X) (f : X -> X'):
  injective f -> map f (s1 \ s2) = (map f s1) \ (map f s2).
move => B0. rewrite /seqminus. elim: s1 => [|x s1 IH] //=.
rewrite map_inj //. case A1: (x \notin s2) => /=; by rewrite IH. Qed.


(*  Copyright 2004 INRIA  *)
Require Export Classical.

Lemma zenon_nottrue :
  (~True -> False).
Proof. tauto. Qed.

Lemma zenon_noteq : forall (T : Type) (t : T),
  ((t <> t) -> False).
Proof. tauto. Qed.

Lemma zenon_and : forall P Q : Prop,
  (P -> Q -> False) -> (P /\ Q -> False).
Proof. tauto. Qed.

Lemma zenon_or : forall P Q : Prop,
  (P -> False) -> (Q -> False) -> (P \/ Q -> False).
Proof. tauto. Qed.

Lemma zenon_imply : forall P Q : Prop,
  (~P -> False) -> (Q -> False) -> ((P -> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_equiv : forall P Q : Prop,
  (~P -> ~Q -> False) -> (P -> Q -> False) -> ((P <-> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notand : forall P Q : Prop,
  (~P -> False) -> (~Q -> False) -> (~(P /\ Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notor : forall P Q : Prop,
  (~P -> ~Q -> False) -> (~(P \/ Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notimply : forall P Q : Prop,
  (P -> ~Q -> False) -> (~(P -> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notequiv : forall P Q : Prop,
  (~P -> Q -> False) -> (P -> ~Q -> False) -> (~(P <-> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_ex : forall (T : Type) (P : T -> Prop),
  (forall z : T, ((P z) -> False)) -> ((exists x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_all : forall (T : Type) (P : T -> Prop) (t : T),
  ((P t) -> False) -> ((forall x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_notex : forall (T : Type) (P : T -> Prop) (t : T),
  (~(P t) -> False) -> (~(exists x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_notall : forall (T : Type) (P : T -> Prop),
  (forall z : T, (~(P z) -> False)) -> (~(forall x : T, (P x)) -> False).
Proof. intros T P Ha Hb. apply Hb. intro. apply NNPP. exact (Ha x). Qed.

Lemma zenon_equal_base : forall (T : Type) (f : T), f = f.
Proof. auto. Qed.

Lemma zenon_equal_step :
  forall (S T : Type) (fa fb : S -> T) (a b : S),
  (fa = fb) -> (a <> b -> False) -> ((fa a) = (fb b)).
Proof. intros. rewrite (NNPP (a = b)). congruence. auto. Qed.

Lemma zenon_pnotp : forall P Q : Prop,
  (P = Q) -> (P -> ~Q -> False).
Proof. intros P Q Ha. rewrite Ha. auto. Qed.

Lemma zenon_notequal : forall (T : Type) (a b : T),
  (a = b) -> (a <> b -> False).
Proof. auto. Qed.

Ltac zenon_intro id :=
  intro id || let nid := fresh in (intro nid; clear nid)
.

Definition zenon_and_s := fun P Q a b => zenon_and P Q b a.
Definition zenon_or_s := fun P Q a b c => zenon_or P Q b c a.
Definition zenon_imply_s := fun P Q a b c => zenon_imply P Q b c a.
Definition zenon_equiv_s := fun P Q a b c => zenon_equiv P Q b c a.
Definition zenon_notand_s := fun P Q a b c => zenon_notand P Q b c a.
Definition zenon_notor_s := fun P Q a b => zenon_notor P Q b a.
Definition zenon_notimply_s := fun P Q a b => zenon_notimply P Q b a.
Definition zenon_notequiv_s := fun P Q a b c => zenon_notequiv P Q b c a.
Definition zenon_ex_s := fun T P a b => zenon_ex T P b a.
Definition zenon_notall_s := fun T P a b => zenon_notall T P b a.

Definition zenon_pnotp_s := fun P Q a b c => zenon_pnotp P Q c a b.
Definition zenon_notequal_s := fun T a b x y => zenon_notequal T a b y x.


(*
(C) Copyright 2010, COQTAIL team

Project Info: http://sourceforge.net/projects/coqtail/

This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.
*)

Require Import Rbase.
Require Import Rsequence.
Require Import Ranalysis.
Require Import Rfunctions.
Require Import Rseries_def.
Require Import Fourier.
Require Import RiemannInt.
Require Import SeqProp.
Require Import Ranalysis_def.
Require Import MyRIneq.

Local Open Scope R_scope.

(** * Intermediate Value Theorem on an Interval and its corollary *)
(** This proof was mainly taken from Reals.Rsqrt_def *)

Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat),
       x < y ->
       interval x y (Dichotomy_ub x y P N) /\ interval x y (Dichotomy_lb x y P N).
Proof.
intros x y P N x_lt_y.
induction N.
 simpl ; intuition.
  split ; [left ; assumption | right ; reflexivity].
  split ; [right ; reflexivity | left ; assumption].
 simpl.
 replace ((Dichotomy_lb x y P N + Dichotomy_ub x y P N) / 2) with
  (middle (Dichotomy_lb x y P N) (Dichotomy_ub x y P N)).
 case (P (middle (Dichotomy_lb x y P N) (Dichotomy_ub x y P N))).
 split.
 apply middle_interval ; intuition.
 intuition.
 split ; [| apply middle_interval] ; intuition.
 unfold middle ; reflexivity.
Qed.

Lemma IVT_interv_prelim1 : forall (x y b:R) (D : R -> bool),
       x < y ->
       Rseq_cv (dicho_up x y D) b ->
       interval x y b.
Proof.
intros x y x0 D x_lt_y bnd.
 assert (Main : forall n, interval x y (dicho_up x y D n)).
  intro n. unfold dicho_up.
  apply (proj1 (IVT_interv_prelim0 x y D n x_lt_y)).
 split.
  apply Rle_cv_lim with (Vn:=dicho_up x y D) (Un:=fun n => x).
  intro n ; exact (proj1 (Main n)).
  unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (x -x) with 0 by field ; rewrite Rabs_R0 ; assumption.
  assumption.
  apply Rle_cv_lim with (Un:=dicho_up x y D) (Vn:=fun n => y).
  intro n ; exact (proj2 (Main n)).
  assumption.
  unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (y -y) with 0 by field ; rewrite Rabs_R0 ; assumption.
Qed.

Lemma IVT_interv : forall (f : R -> R) (x y : R),
       continuity_interval f x y ->
       x < y ->
       interval (f x) (f y) 0 ->
       {z : R | interval x y z /\ f z = 0}.
Proof.
intros f x y H H0 [H1 H2].
 case (Rle_lt_or_eq_dec _ _ H1) ; clear H1 ; intro H1.
 case (Rle_lt_or_eq_dec _ _ H2) ; clear H2 ; intro H2.
  cut (x <= y).
  intro.
  generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3).
  generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3).
  intros X X0.
  elim X; intros.
  elim X0; intros.
  assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
  rewrite H4 in p0.
  exists x0.
  split.
  split.
  apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
  simpl in |- *.
  right; reflexivity.
  apply growing_ineq.
  apply dicho_lb_growing; assumption.
  assumption.
  apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
  apply decreasing_ineq.
  apply dicho_up_decreasing; assumption.
  assumption.
  right; reflexivity.
  2: left; assumption.
  set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
  set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
  cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
  cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
  intros.
  cut (forall n:nat, f (Vn n) <= 0).
  cut (forall n:nat, 0 <= f (Wn n)).
  intros.
  assert (H9 := H6 H8).
  assert (H10 := H5 H7).
  apply Rle_antisym; assumption.
  intro.
  unfold Wn in |- *.
  cut (forall z:R, cond_positivity z = true <-> 0 <= z).
  intro.
  assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
  elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
  apply H9.
  apply H8.
  elim (H7 (f y)); intros.
  apply H12.
  left ; assumption.
  intro.
  unfold cond_positivity in |- *.
  case (Rle_dec 0 z); intro.
  split.
  intro; assumption.
  intro; reflexivity.
  split.
  intro feqt;discriminate feqt.
  intro.
  elim n0; assumption.
  unfold Vn in |- *.
  cut (forall z:R, cond_positivity z = false <-> z < 0).
  intros.
  assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
  elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
  left ; apply H9.
  apply H8.
  elim (H7 (f x)); intros.
  apply H12.
  assumption.
  intro.
  unfold cond_positivity in |- *.
  case (Rle_dec 0 z); intro.
  split.
  intro feqt; discriminate feqt.
  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)).
  split.
  intro; auto with real.
  intro; reflexivity.
  cut (Un_cv Wn x0).
  intros.
  assert (Temp : x <= x0 <= y).
   apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
  assert (H7 := continuity_seq f Wn x0 (H x0 Temp) H5).
  case (total_order_T 0 (f x0)); intro.
  elim s; intro.
  left; assumption.
  rewrite <- b; right; reflexivity.
  unfold Un_cv in H7; unfold R_dist in H7.
  cut (0 < - f x0).
  intro.
  elim (H7 (- f x0) H8); intros.
  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
  assert (H11 := H9 x2 H10).
  rewrite Rabs_right in H11.
  pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
  unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
  assert (H12 := Rplus_lt_reg_r _ _ _ H11).
  assert (H13 := H6 x2).
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
  apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
  apply H6.
  exact H8.
  apply Ropp_0_gt_lt_contravar; assumption.
  unfold Wn in |- *; assumption.
  cut (Un_cv Vn x0).
  intros.
  assert (Temp : x <= x0 <= y).
   apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
  assert (H7 := continuity_seq f Vn x0 (H x0 Temp) H5).
  case (total_order_T 0 (f x0)); intro.
  elim s; intro.
  unfold Un_cv in H7; unfold R_dist in H7.
  elim (H7 (f x0) a); intros.
  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
  assert (H10 := H8 x2 H9).
  rewrite Rabs_left in H10.
  pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
  rewrite Ropp_minus_distr' in H10.
  unfold Rminus in H10.
  assert (H11 := Rplus_lt_reg_r _ _ _ H10).
  assert (H12 := H6 x2).
  cut (0 < f (Vn x2)).
  intro.
  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
  rewrite <- (Ropp_involutive (f (Vn x2))).
  apply Ropp_0_gt_lt_contravar; assumption.
  apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
  rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
    [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
  assumption.
  apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
  right; rewrite <- b; reflexivity.
  left; assumption.
  unfold Vn in |- *; assumption.
  exists y ; repeat split ; intuition.
  exists x ; repeat split ; intuition.
Qed.