(**
This file is part of the Coquelicot formalization of real
analysis in Coq: http://coquelicot.saclay.inria.fr/

Copyright (C) 2011-2015 Sylvie Boldo
#
#
Copyright (C) 2011-2015 Catherine Lelay
#
#
Copyright (C) 2011-2015 Guillaume Melquiond

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 3 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
COPYING file for more details.
*)

Require Import Reals Psatz.
Require Import mathcomp.ssreflect.ssreflect.
Require Import Rbar Rcomplements Hierarchy.

(** This file gives definitions of equivalent (g ~ f) and dominant (g
= o(f)). This is used for defining differentiability on a
[NormedModule]. *)

Definition is_domin {T} {Ku Kv : AbsRing}
  {U : NormedModule Ku} {V : NormedModule Kv}
  (F : (T -> Prop) -> Prop) (f : T -> U) (g : T -> V) :=
  forall eps : posreal, F (fun x => norm (g x) <= eps * norm (f x)).

Definition is_equiv {T} {K : AbsRing} {V : NormedModule K}
  (F : (T -> Prop) -> Prop) (f g : T -> V) :=
  is_domin F g (fun x => minus (g x) (f x)).

(** To be dominant is a partial strict order *)

Lemma domin_antisym {T} {K : AbsRing} {V : NormedModule K} :
  forall {F : (T -> Prop) -> Prop} {FF : ProperFilter F} (f : T -> V),
  F (fun x => norm (f x) <> 0) -> ~ is_domin F f f.
Proof.
intros F FF f Hf H.
move: (H (pos_div_2 (mkposreal _ Rlt_0_1))) => {H} /= H.
apply filter_const.
generalize (filter_and _ _ H Hf) => {H Hf}.
apply filter_imp.
intros x [H1 H2].
generalize (norm_ge_0 (f x)).
lra.
Qed.

Lemma domin_trans {T} {Ku Kv Kw : AbsRing}
   {U : NormedModule Ku} {V : NormedModule Kv} {W : NormedModule Kw} :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (h : T -> W),
  is_domin F f g -> is_domin F g h -> is_domin F f h.
Proof.
  intros F FF f g h Hfg Hgh eps.
  apply (filter_imp (fun x => (norm (h x) <= sqrt eps * norm (g x)) /\ (norm (g x) <= sqrt eps * norm (f x)))).
  intros x [H0 H1].
  apply Rle_trans with (1 := H0).
  rewrite -{2}(sqrt_sqrt eps).
  rewrite Rmult_assoc.
  apply Rmult_le_compat_l.
  by apply sqrt_pos.
  apply H1.
  by apply Rlt_le, eps.
  apply filter_and.
  by apply (Hgh (mkposreal (sqrt eps) (sqrt_lt_R0 _ (cond_pos eps)))).
  by apply (Hfg (mkposreal (sqrt eps) (sqrt_lt_R0 _ (cond_pos eps)))).
Qed.

(** Relations between domination and equivalence *)

Lemma equiv_le_2 {T} {K : AbsRing} {V : NormedModule K}
  F {FF : Filter F} (f g : T -> V) :
  is_equiv F f g ->
  F (fun x => norm (g x) <= 2 * norm (f x) /\ norm (f x) <= 2 * norm (g x)).
Proof.
  intros H.
  apply filter_and.
  - move: (H (pos_div_2 (mkposreal _ Rlt_0_1))) => {H}.
    apply filter_imp => x /= H.
    apply Rle_trans with (1 := norm_triangle_inv _ _) in H.
    rewrite -Ropp_minus_distr Rabs_Ropp in H.
    apply Rabs_le_between' in H ; case: H => H _.
    field_simplify in H.
    rewrite Rdiv_1 in H.
    apply Rle_div_l in H.
    by rewrite Rmult_comm.
    by apply Rlt_0_2.
  - move: (H (mkposreal _ Rlt_0_1)) => {H}.
    apply filter_imp => x /= H.
    apply Rle_trans with (1 := norm_triangle_inv _ _) in H.
    rewrite -Ropp_minus_distr Rabs_Ropp in H.
    apply Rabs_le_between' in H ; case: H => _ H.
    field_simplify in H.
    by rewrite !Rdiv_1 in H.
Qed.

Lemma domin_rw_l {T} {Ku Kv : AbsRing}
  {U : NormedModule Ku} {V : NormedModule Kv} :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 : T -> U) (g : T -> V),
  is_equiv F f1 f2 -> is_domin F f1 g -> is_domin F f2 g.
Proof.
  intros F FF f1 f2 g Hf Hg eps.
  assert (F (fun x => norm (f1 x) <= 2 * norm (f2 x))).
    eapply filter_imp.
    2: apply (equiv_le_2 _ _ _ Hf).
    move => /= x Hx.
    by apply Hx.
  clear Hf ; rename H into Hf.
  specialize (Hg (pos_div_2 eps)).
  generalize (filter_and _ _ Hf Hg) ; clear -FF.
  apply filter_imp => x /= [Hf Hg].
  apply Rle_trans with (1 := Hg).
  rewrite /Rdiv Rmult_assoc.
  apply Rmult_le_compat_l.
  by apply Rlt_le, eps.
  rewrite Rmult_comm Rle_div_l.
  by rewrite Rmult_comm.
  by apply Rlt_0_2.
Qed.

Lemma domin_rw_r {T} {Ku Kv : AbsRing}
  {U : NormedModule Ku} {V : NormedModule Kv} :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g1 g2 : T -> V),
  is_equiv F g1 g2 -> is_domin F f g1 -> is_domin F f g2.
Proof.
  intros F FF f g1 g2 Hg Hf eps.
  assert (F (fun x => norm (g2 x) <= 2 * norm (g1 x))).
    eapply filter_imp.
    2: apply (equiv_le_2 _ _ _ Hg).
    move => /= x Hx.
    by apply Hx.
  clear Hg ; rename H into Hg.
  specialize (Hf (pos_div_2 eps)).
  generalize (filter_and _ _ Hf Hg) ; clear -FF.
  apply filter_imp => x /= [Hf Hg].
  apply Rle_trans with (1 := Hg).
  rewrite Rmult_comm Rle_div_r.
  apply Rle_trans with (1 := Hf).
  right ; rewrite /Rdiv ; ring.
  by apply Rlt_0_2.
Qed.

(** To be equivalent is an equivalence relation *)

Section Equiv.

Context {T : Type} {K : AbsRing} {V : NormedModule K}.

Lemma equiv_refl :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> V),
  is_equiv F f f.
Proof.
  intros F FF f eps.
  apply: filter_forall => x.
  rewrite /minus plus_opp_r norm_zero.
  apply Rmult_le_pos.
  by apply Rlt_le, eps.
  by apply norm_ge_0.
Qed.

Lemma equiv_sym :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V),
  is_equiv F f g -> is_equiv F g f.
Proof.
  intros F FF f g H eps.
  assert (H0 := equiv_le_2 _ _ _ H).
  specialize (H (pos_div_2 eps)).
  generalize (filter_and _ _ H H0) ; apply filter_imp ;
  clear => x [H [H0 H1]].
  rewrite -norm_opp /minus opp_plus opp_opp plus_comm.
  apply Rle_trans with (1 := H) ; simpl.
  eapply Rle_trans.
  apply Rmult_le_compat_l.
  by apply Rlt_le, is_pos_div_2.
  by apply H0.
  apply Req_le ; field.
Qed.

Lemma equiv_trans :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> V),
  is_equiv F f g -> is_equiv F g h -> is_equiv F f h.
Proof.
  intros F FF f g h Hfg Hgh.
  apply (fun c => domin_rw_l _ _ c Hgh).
  intros eps.
  apply equiv_sym in Hgh.
  generalize (filter_and _ _ (Hfg (pos_div_2 eps)) (Hgh (pos_div_2 eps))) => {Hfg Hgh}.
  apply filter_imp => x /= [Hfg Hgh].
  replace (minus (h x) (f x)) with (plus (minus (g x) (f x)) (opp (minus (g x) (h x)))).
  eapply Rle_trans. 1 : by apply @norm_triangle.
  rewrite norm_opp (double_var eps) Rmult_plus_distr_r.
  by apply Rplus_le_compat.
  rewrite /minus opp_plus opp_opp plus_comm plus_assoc.
  congr (plus _ (opp (f x))).
  rewrite plus_comm plus_assoc plus_opp_r.
  apply plus_zero_l.
Qed.

Lemma equiv_carac_0 :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V),
  is_equiv F f g ->
  {o : T -> V | (forall x : T, f x = plus (g x) (o x)) /\ is_domin F g o }.
Proof.
  intros F FF f g H.
  exists (fun x => minus (f x) (g x)).
  split.
  intro x.
  by rewrite /minus plus_comm -plus_assoc plus_opp_l plus_zero_r.
  apply (domin_rw_l _ _ _ H).
  by apply equiv_sym.
Qed.

Lemma equiv_carac_1 :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g o : T -> V),
  (forall x, f x = plus (g x) (o x)) -> is_domin F g o -> is_equiv F f g.
Proof.
  intros F FF f g o Ho Hgo.
  intro eps ; move: (Hgo eps).
  apply filter_imp => x.
  replace (o x) with (minus (f x) (g x)).
  congr (_ <= _).
  by rewrite -norm_opp /minus opp_plus opp_opp plus_comm.
  rewrite Ho.
  rewrite /minus plus_comm plus_assoc plus_opp_l.
  apply plus_zero_l.
Qed.

Lemma equiv_ext_loc {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V) :
  F (fun x => f x = g x) -> is_equiv F f g.
Proof.
  move => H eps.
  move: H ; apply filter_imp.
  move => x ->.
  rewrite /minus plus_opp_r norm_zero.
  apply Rmult_le_pos.
  by apply Rlt_le, eps.
  by apply norm_ge_0.
Qed.

End Equiv.

(** * Vector space *)
(** is_domin is a vector space *)

Section Domin.

Context {T : Type} {Ku Kv : AbsRing}
  {U : NormedModule Ku} {V : NormedModule Kv}.

Lemma is_domin_le {F G} (f : T -> U) (g : T -> V) :
  is_domin F f g -> filter_le G F -> is_domin G f g.
Proof.
  intros.
  intros eps.
  by apply H0.
Qed.

Lemma domin_scal_r  :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (c : Kv),
  is_domin F f g -> is_domin F f (fun x => scal c (g x)).
Proof.
  intros F FF f g c H.
  case: (Req_dec (abs c) 0) => Hc.
  move => eps /=.
  apply filter_imp with (2 := filter_true) => x _.
  eapply Rle_trans.
  apply @norm_scal.
  rewrite Hc Rmult_0_l.
  apply Rmult_le_pos.
  by apply Rlt_le, eps.
  by apply norm_ge_0.

  destruct (abs_ge_0 c) => //.
  clear Hc ; rename H0 into Hc.
  move => eps /=.
  assert (He : 0 < eps / abs c).
    apply Rdiv_lt_0_compat.
    by apply eps.
    by apply Hc.
  move: (H (mkposreal _ He)) => /= {H}.
  apply filter_imp => x H.
  eapply Rle_trans.
  apply @norm_scal.
  rewrite Rmult_comm ; apply Rle_div_r.
  by [].
  apply Rle_trans with (1 := H).
  apply Req_le ; rewrite /Rdiv ; ring.
  by apply sym_eq in H0.
Qed.

Lemma domin_scal_l :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (c : Ku),
  (exists y, mult y c = one) -> is_domin F f g -> is_domin F (fun x => scal c (f x)) g.
Proof.
  intros F FF f g c Hc H eps.
  destruct Hc as [y Hc].
  assert (0 < abs c).
    apply Rnot_le_lt => H0.
    destruct H0.
    move: H0 ; by apply Rle_not_lt, abs_ge_0.
    move: H0.
    apply (Rmult_neq_0_reg (abs y)).
    apply Rgt_not_eq.
    eapply Rlt_le_trans, @abs_mult.
    rewrite Hc abs_one ; by apply Rlt_0_1.
  assert (0 < abs y).
    apply Rmult_lt_reg_r with (abs c).
    by [].
    rewrite Rmult_0_l.
    eapply Rlt_le_trans, @abs_mult.
    rewrite Hc abs_one ; by apply Rlt_0_1.
  assert (He : (0 < eps / abs y)).
    apply Rdiv_lt_0_compat.
    by apply eps.
    by [].
  move: (H (mkposreal _ He)) => /= {H}.
  apply filter_imp => x Hx.
  apply Rle_trans with (1 := Hx).
  rewrite /Rdiv Rmult_assoc ; apply Rmult_le_compat_l.
  by apply Rlt_le, eps.
  rewrite -{1}(scal_one (f x)) -Hc -scal_assoc.
  eapply Rle_trans.
  apply Rmult_le_compat_l.
  by apply Rlt_le, Rinv_0_lt_compat.
  apply @norm_scal.
  apply Req_le ; field.
  by apply Rgt_not_eq.
Qed.

Lemma domin_plus :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g1 g2 : T -> V),
  is_domin F f g1 -> is_domin F f g2 -> is_domin F f (fun x => plus (g1 x) (g2 x)).
Proof.
  intros F FF f g1 g2 Hg1 Hg2 eps.
  generalize (filter_and _ _ (Hg1 (pos_div_2 eps)) (Hg2 (pos_div_2 eps)))
    => /= {Hg1 Hg2}.
  apply filter_imp => x [Hg1 Hg2].
  eapply Rle_trans.
  apply @norm_triangle.
  eapply Rle_trans.
  apply Rplus_le_compat.
  by apply Hg1.
  by apply Hg2.
  apply Req_le ; field.
Qed.

End Domin.

(** is_equiv is compatible with the vector space structure *)

Section Equiv_VS.

Context {T : Type} {K : AbsRing} {V : NormedModule K}.

Lemma equiv_scal :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V) (c : K),
  (exists y : K, mult y c = one) ->
  is_equiv F f g -> is_equiv F (fun x => scal c (f x)) (fun x => scal c (g x)).
Proof.
  intros F FF f g c [y Hc] H.
  apply domin_scal_l.
  by exists y.
  move => eps /=.
  cut (F (fun x => norm (scal c (minus (g x) (f x))) <= eps * norm (g x))).
  apply filter_imp => x.
  now rewrite scal_distr_l scal_opp_r.
  now apply domin_scal_r.
Qed.

Lemma equiv_plus :
  forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f o : T -> V),
  is_domin F f o -> is_equiv F (fun x => plus (f x) (o x)) f.
Proof.
  intros F FF f o H eps.
  move: (H eps) => {H}.
  apply filter_imp => x Hx.
  simpl.
  now rewrite /minus opp_plus plus_assoc plus_opp_r plus_zero_l norm_opp.
Qed.

End Equiv_VS.

(** * Multiplication and inverse *)
(** Domination *)

Lemma domin_mult_r :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> R),
  is_domin F f g -> is_domin F (fun x => f x * h x) (fun x => g x * h x).
Proof.
  intros T F FF f g h H eps.
  move: (H eps) => {H}.
  apply filter_imp => x H1.
  rewrite /norm /= /abs /= ?Rabs_mult.
  rewrite -Rmult_assoc.
  apply Rmult_le_compat_r.
  by apply Rabs_pos.
  by apply H1.
Qed.

Lemma domin_mult_l :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> R),
  is_domin F f g -> is_domin F (fun x => h x * f x) (fun x => h x * g x).
Proof.
  intros T F FF f g h H eps.
  generalize (domin_mult_r f g h H eps).
  apply filter_imp => x.
  by rewrite ?(Rmult_comm (h x)).
Qed.

Lemma domin_mult :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 g1 g2 : T -> R),
  is_domin F f1 g1 -> is_domin F f2 g2 ->
  is_domin F (fun x => f1 x * f2 x) (fun x => g1 x * g2 x).
Proof.
  intros T F FF f1 f2 g1 g2 H1 H2 eps.
  move: (H1 (mkposreal _ (sqrt_lt_R0 _ (cond_pos eps))))
    (H2 (mkposreal _ (sqrt_lt_R0 _ (cond_pos eps)))) => {H1 H2} /= H1 H2.
  generalize (filter_and _ _ H1 H2) => {H1 H2}.
  apply filter_imp => x [H1 H2].
  rewrite /norm /= /abs /= ?Rabs_mult.
  rewrite -(sqrt_sqrt _ (Rlt_le _ _ (cond_pos eps))).
  replace (sqrt eps * sqrt eps * (Rabs (f1 x) * Rabs (f2 x)))
    with ((sqrt eps * Rabs (f1 x))*(sqrt eps * Rabs (f2 x))) by ring.
  apply Rmult_le_compat.
  by apply Rabs_pos.
  by apply Rabs_pos.
  by apply H1.
  by apply H2.
Qed.

Lemma domin_inv :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R),
  F (fun x => g x <> 0) -> is_domin F f g ->
  is_domin F (fun x => / g x) (fun x => / f x).
Proof.
  intros T F FF f g Hg H eps.
  have Hf : F (fun x => f x <> 0).
    generalize (filter_and _ _ Hg (H (mkposreal _ Rlt_0_1))) => /=.
    apply filter_imp => x {Hg H} [Hg H].
    case: (Req_dec (f x) 0) => Hf.
    rewrite /norm /= /abs /= Hf Rabs_R0 Rmult_0_r in H.
    apply Rlt_not_le in H.
    move => _ ; apply H.
    by apply Rabs_pos_lt.
    by [].
  generalize (filter_and _ _ (H eps) (filter_and _ _ Hf Hg)) => {H Hf Hg}.
  apply filter_imp => x [H [Hf Hg]].
  rewrite /norm /= /abs /= ?Rabs_Rinv => //.
  replace (/ Rabs (f x))
    with (Rabs (g x) / (Rabs (f x) * Rabs (g x)))
    by (field ; split ; by apply Rabs_no_R0).
  replace (eps * / Rabs (g x))
    with (eps * Rabs (f x) / (Rabs (f x) * Rabs (g x)))
    by (field ; split ; by apply Rabs_no_R0).
  apply Rmult_le_compat_r.
  apply Rlt_le, Rinv_0_lt_compat, Rmult_lt_0_compat ; apply Rabs_pos_lt => //.
  by apply H.
Qed.

(** Equivalence *)

Lemma equiv_mult :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 g1 g2 : T -> R),
  is_equiv F f1 g1 -> is_equiv F f2 g2 ->
  is_equiv F (fun x => f1 x * f2 x) (fun x => g1 x * g2 x).
Proof.
  intros T F FF f1 f2 g1 g2 H1 H2.
  case: (equiv_carac_0 _ _ H1) => {H1} o1 [H1 Ho1].
  case: (equiv_carac_0 _ _ H2) => {H2} o2 [H2 Ho2].
  apply equiv_carac_1 with (fun x => o1 x * g2 x + g1 x * o2 x + o1 x * o2 x).
  move => x ; rewrite H1 H2 /plus /= ; ring.
  repeat apply @domin_plus => //.
  by apply domin_mult_r.
  by apply domin_mult_l.
  by apply domin_mult.
Qed.

Lemma equiv_inv :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R),
  F (fun x => g x <> 0) -> is_equiv F f g ->
  is_equiv F (fun x => / f x) (fun x => / g x).
Proof.
  intros T F FF f g Hg H.
  have Hf : F (fun x => f x <> 0).
    generalize (filter_and _ _ Hg (H (pos_div_2 (mkposreal _ Rlt_0_1)))) => /=.
    apply filter_imp => x {Hg H} [Hg H].
    case: (Req_dec (f x) 0) => Hf //.
    rewrite /minus /plus /opp /= Hf Ropp_0 Rplus_0_r in H.
    generalize (norm_ge_0 (g x)) (norm_eq_zero (g x)).
    rewrite /zero /=.
    lra.
  apply equiv_sym in H.
  move => eps.
  generalize (filter_and _ _ (filter_and _ _ Hf Hg) (H eps)).
  clear -FF.
  apply filter_imp.
  intros x [[Hf Hg] H].
  rewrite /norm /= /abs /minus /plus /opp /=.
  replace (/ g x + - / f x)
    with ((f x - g x) / (f x * g x)).
  rewrite Rabs_div ?Rabs_Rinv ?Rabs_mult //.
  apply Rle_div_l.
  apply Rmult_lt_0_compat ; by apply Rabs_pos_lt.
  field_simplify ; rewrite ?Rdiv_1.
  by [].
  by apply Rabs_no_R0.
  by apply Rmult_integral_contrapositive_currified.
  field ; by split.
Qed.

(** * Domination and composition *)

Section Domin_comp.

Context {T1 T2 : Type} {Ku Kv : AbsRing}
  {U : NormedModule Ku} {V : NormedModule Kv}
  (F : (T1 -> Prop) -> Prop) {FF : Filter F}
  (G : (T2 -> Prop) -> Prop) {FG : Filter G}.

Lemma domin_comp (f : T2 -> U) (g : T2 -> V) (l : T1 -> T2) :
  filterlim l F G -> is_domin G f g
    -> is_domin F (fun t => f (l t)) (fun t => g (l t)).
Proof.
  intros Hl Hg eps.
  generalize (fun eps => Hl _ (Hg eps)) => {Hl Hg} /= Hl.
  by apply Hl.
Qed.

End Domin_comp.

(** * Equivalence and limits *)

Lemma filterlim_equiv :
  forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R) (l : Rbar),
  is_equiv F f g ->
  filterlim f F (Rbar_locally l) ->
  filterlim g F (Rbar_locally l).
Proof.
intros T F FF f g [l| |] Hfg Hf P [eps HP] ;
  apply equiv_sym in Hfg ;
  unfold filtermap.
- assert (He: 0 < eps / 2 / (Rabs l + 1)).
  apply Rdiv_lt_0_compat.
  apply is_pos_div_2.
  apply Rplus_le_lt_0_compat.
  apply Rabs_pos.
  apply Rlt_0_1.
  pose ineqs (y : R) := Rabs (y - l) < eps/2 /\ Rabs y <= Rabs l + 1.
  assert (Hl: Rbar_locally l ineqs).
  assert (H: 0 < Rmin (eps / 2) 1).
  apply Rmin_case.
  apply is_pos_div_2.
  apply Rlt_0_1.
  exists (mkposreal _ H).
  simpl.
  intros x Hx.
  split.
  apply Rlt_le_trans with (1 := Hx).
  apply Rmin_l.
  apply Rabs_le_between'.
  apply Rle_trans with (1 := Rabs_triang_inv2 _ _).
  apply Rlt_le.
  apply Rlt_le_trans with (1 := Hx).
  apply Rmin_r.
  generalize (filter_and  _  (fun (x : T) =>  ineqs (f x))  (Hfg (mkposreal _ He))  (Hf _ Hl)).
  apply filter_imp.
  simpl.
  intros x [H1 [H2 H3]].
  apply HP.
  rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=.
  replace (g x + - l) with ((f x - l) + -(f x - g x)) by ring.
  apply Rle_lt_trans with (1 := Rabs_triang _ _).
  replace (pos eps) with (eps / 2 + eps / 2 / (Rabs l + 1) * (Rabs l + 1)).
  apply Rplus_lt_le_compat with (1 := H2).
  rewrite Rabs_Ropp.
  apply Rle_trans with (1 := H1).
  apply Rmult_le_compat_l with (2 := H3).
  now apply Rlt_le.
  field.
  apply Rgt_not_eq.
  apply Rplus_le_lt_0_compat.
  apply Rabs_pos.
  apply Rlt_0_1.
- pose ineq (y : R) := Rmax 0 (2 * eps) < y.
  assert (Hl: Rbar_locally' p_infty ineq).
  now exists (Rmax 0 (2 * eps)).
  generalize (filter_and _ (fun (x : T) => ineq (f x)) (Hfg (mkposreal _ pos_half_prf)) (Hf _ Hl)).
  apply filter_imp.
  simpl.
  intros x [H1 H2].
  apply HP.
  apply Rabs_le_between' in H1.
  generalize (Rplus_le_compat_l (- /2 * Rabs (f x)) _ _ (proj2 H1)).
  rewrite /norm /= /abs /=.
  replace (- / 2 * Rabs (f x) + (g x + / 2 * Rabs (f x))) with (g x) by ring.
  apply Rlt_le_trans.
  rewrite Rabs_pos_eq.
  apply Rmult_lt_reg_l with (1 := Rlt_R0_R2).
  replace (2 * (- / 2 * f x + f x)) with (f x) by field.
  apply Rle_lt_trans with (2 := H2).
  apply Rmax_r.
  apply Rlt_le.
  apply Rle_lt_trans with (2 := H2).
  apply Rmax_l.
- pose ineq (y : R) := y < Rmin 0 (2 * eps).
  assert (Hl: Rbar_locally' m_infty ineq).
  now exists (Rmin 0 (2 * eps)).
  generalize (filter_and _ (fun (x : T) => ineq (f x)) (Hfg (mkposreal _ pos_half_prf)) (Hf _ Hl)).
  apply filter_imp.
  simpl.
  intros x [H1 H2].
  apply HP.
  apply Rabs_le_between' in H1.
  generalize (Rplus_le_compat_l (/2 * Rabs (f x)) _ _ (proj1 H1)).
  rewrite /norm /= /abs /=.
  replace (/ 2 * Rabs (f x) + (g x - / 2 * Rabs (f x))) with (g x) by ring.
  intros H.
  apply Rle_lt_trans with (1 := H).
  rewrite Rabs_left.
  apply Rmult_lt_reg_l with (1 := Rlt_R0_R2).
  replace (2 * (/ 2 * - f x + f x)) with (f x) by field.
  apply Rlt_le_trans with (1 := H2).
  apply Rmin_r.
  apply Rlt_le_trans with (1 := H2).
  apply Rmin_l.
Qed.


(*---------------------------------------------------------------------------
    This file axiomatises the inference rules of an intuitionistic logic and
    offers some parametric instances to make it straightforward to create a new
    logic that satisfies those axioms. The purpose is to factor out what the
    assertion logic and specification logic of a separation logic framework
    have in common.
  ---------------------------------------------------------------------------*)
Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms Coq.Classes.RelationClasses Coq.Program.Basics Coq.omega.Omega.
Require Import x86proved.charge.csetoid.

(* We [Require] (and later [Import]) ssreflect, because when we inline
   this file into other files, having ssreflect required in other
   files breaks some notations in this one. *)
Require Ssreflect.ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.

(* The natural numbers in descending order. *)
Global Instance ge_Pre: PreOrder ge.
Proof. repeat constructor. hnf. eauto with arith. Qed.

Module WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.
Import Ssreflect.ssreflect.
(* These tactics are meant to relieve the user from remembering morphism names.
   In most cases they will apply the most general morphism for the arity
   requested. *)
(* TODO: move this somewhere more general. *)
Ltac postcancel := unfold Basics.flip; trivial.
Ltac cancel1 :=
  apply (proper_prf (Proper := _: Proper (_ ==> _) _));
  postcancel.
Ltac cancel2 :=
  apply (proper_prf (Proper := _: Proper (_ ==> _ ==> _) _));
  postcancel.
Ltac cancel3 :=
  apply (proper_prf (Proper := _: Proper (_ ==> _ ==> _ ==> _) _));
  postcancel.
End WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.
Ltac postcancel := WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.postcancel.
Ltac cancel1 := WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.cancel1.
Ltac cancel2 := WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.cancel2.
Ltac cancel3 := WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt.cancel3.

Class Inhabited A := { cinhabited : inhabited A}.

Instance blr: Inhabited nat.
Proof. split; split; apply 0. Qed.

Generalizable Variables Frm.

(* Logical connectives *)
Class ILogicOps Frm := {
  lentails: relation Frm;
  ltrue: Frm;
  lfalse: Frm;
  limpl: Frm -> Frm -> Frm;
  land: Frm -> Frm -> Frm;
  lor: Frm -> Frm -> Frm;
  lforall: forall {T}, (T -> Frm) -> Frm;
  lexists: forall {T}, (T -> Frm) -> Frm
}.

(* These notations have to sit strictly between level 80 (precendence of /\)
   and level 70 (precedence of =). *)
Infix "|--"  := lentails (at level 79, no associativity).
Infix "//\\"   := land (at level 75, right associativity).
Infix "\\//"   := lor (at level 76, right associativity).
Infix "-->>"   := limpl (at level 77, right associativity).
Notation "'Forall' x : T , p" :=
  (lforall (fun x : T => p)) (at level 78, x ident, right associativity).
Notation "'Forall' x .. y , p" :=
  (lforall (fun x => .. (lforall (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity).
Notation "'Exists' x : T , p" :=
  (lexists (fun x : T => p)) (at level 78, x ident, right associativity).
Notation "'Exists' x .. y , p" :=
  (lexists (fun x => .. (lexists (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity).

(* Axioms of an intuitionistic logic, presented in a sequent calculus style
   with singleton contexts on the left of the turnstile. This form is
   particularly suited for the undisciplined context manipulation that tends to
   happen in separation logic.

   Every connective has a number of L-rules and a number of R-rules describing
   what can be done to prove a goal that has the connective as the head symbol
   of the left, respectively right, side of a turnstile. The notable exception
   to this pattern is implication, which is required to be the right adjoint of
   conjunction. This makes singleton contexts work. *)
Class ILogic Frm {ILOps: ILogicOps Frm} := {
  lentailsPre:> PreOrder lentails;
  ltrueR: forall C, C |-- ltrue;
  lfalseL: forall C, lfalse |-- C;
  lforallL: forall T x (P: T -> Frm) C, P x |-- C -> lforall P |-- C;
  lforallR: forall T (P: T -> Frm) C, (forall x, C |-- P x) -> C |-- lforall P;
  lexistsL: forall T (P: T -> Frm) C, (forall x, P x |-- C) -> lexists P |-- C;
  lexistsR: forall T x (P: T -> Frm) C, C |-- P x -> C |-- lexists P;
  landL1: forall P Q C, P |-- C  ->  P //\\ Q |-- C;
  landL2: forall P Q C, Q |-- C  ->  P //\\ Q |-- C;
  lorR1:  forall P Q C, C |-- P  ->  C |-- P \\// Q;
  lorR2:  forall P Q C, C |-- Q  ->  C |-- P \\// Q;
  landR:  forall P Q C, C |-- P  ->  C |-- Q  ->  C |-- P //\\ Q;
  lorL:   forall P Q C, P |-- C  ->  Q |-- C  ->  P \\// Q |-- C;
  landAdj: forall P Q C, C |-- (P -->> Q) -> C //\\ P |-- Q;
  limplAdj: forall P Q C, C //\\ P |-- Q -> C |-- (P -->> Q)
}.
Implicit Arguments ILogic [[ILOps]].

Notation "|-- P" := (ltrue |-- P) (at level 85, no associativity).
Hint Extern 0 (?x |-- ?x) => reflexivity.
Hint Extern 0 (_ |-- ltrue) => apply ltrueR.
Hint Extern 0 (lfalse |-- _) => apply lfalseL.
Hint Extern 0 (?P |-- ?Q) => (is_evar P; reflexivity) || (is_evar Q; reflexivity).

Section ILogicExtra.
  Context `{IL: ILogic Frm}.

  Definition lequiv P Q := P |-- Q /\ Q |-- P.
  Definition lpropand (p: Prop) Q := Exists _: p, Q.
  Definition lpropimpl (p: Prop) Q := Forall _: p, Q.

End ILogicExtra.

Infix "/\\" := lpropand (at level 75, right associativity).
Infix "->>" := lpropimpl (at level 77, right associativity).
Infix "-|-"  := lequiv (at level 85, no associativity).

Hint Extern 0 (?x -|- ?x) => reflexivity.
Hint Extern 0 (?P -|- ?Q) => (is_evar P; reflexivity) || (is_evar Q; reflexivity).

Section ILogicMorphisms.
  Context `{IL: ILogic Frm}.

  Global Instance lequivEqu : Equivalence lequiv.
  Proof.
    unfold lequiv. constructor; red.
    + split; reflexivity.
    + intuition.
    + intros P Q R [HPQ HQP] [HQR HRQ];
      split; etransitivity; eassumption.
  Qed.

  Global Instance lequiv_lentails : subrelation lequiv lentails.
  Proof. firstorder. Qed.
  Global Instance lequiv_inverse_lentails: subrelation lequiv (inverse lentails).
  Proof. firstorder. Qed.

  Global Instance lforall_lentails_m T:
    Proper (pointwise_relation T lentails ++> lentails) lforall.
  Proof.
    intros P P' HP. apply lforallR; intro x; apply lforallL with x.
    rewrite HP; reflexivity.
  Qed.

  Global Instance lforall_lequiv_m T:
    Proper (pointwise_relation T lequiv ++> lequiv) lforall.
  Proof.
    intros P P' HP; split; apply lforall_lentails_m; intro x; apply HP.
  Qed.

  Global Instance lexists_lentails_m T:
    Proper (pointwise_relation T lentails ++> lentails) lexists.
  Proof.
    intros P P' HP. apply lexistsL; intro x; apply lexistsR with x.
    rewrite HP; reflexivity.
  Qed.

  Global Instance lexists_lequiv_m T:
    Proper (pointwise_relation T lequiv ++> lequiv) lexists.
  Proof.
    intros P P' HP; split; apply lexists_lentails_m; intro x; apply HP.
  Qed.

  Global Instance : Proper (lequiv ==> lequiv ==> iff) lequiv.
  Proof.
    intuition.
  Qed.

  Global Instance lequiv_lentails_m : Proper (lequiv ==> lequiv ==> iff) lentails.
  Proof.
    cbv; intuition; (etransitivity; [etransitivity|]); eassumption.
  Qed.

  Global Instance lentails_lentails_m: Proper (lentails --> lentails ++> impl) lentails.
  Proof.
    intuition.
  Qed.

  Global Instance land_lentails_m:
    Proper (lentails ++> lentails ++> lentails) land.
  Proof.
    intros P P' HP Q Q' HQ.
    apply landR; [apply landL1 | apply landL2]; assumption.
  Qed.

  Global Instance land_lequiv_m:
    Proper (lequiv ==> lequiv ==> lequiv) land.
  Proof.
    intros P P' HP Q Q' HQ.
    split; apply land_lentails_m; (apply HP || apply HQ).
  Qed.

  Global Instance lor_lentails_m:
    Proper (lentails ++> lentails ++> lentails) lor.
  Proof.
    intros P P' HP Q Q' HQ.
    apply lorL; [apply lorR1 | apply lorR2]; assumption.
  Qed.

  Global Instance lor_lequiv_m:
    Proper (lequiv ==> lequiv ==> lequiv) lor.
  Proof.
    intros P P' HP Q Q' HQ.
    split; apply lor_lentails_m; (apply HP || apply HQ).
  Qed.

  Global Instance limpl_lentails_m:
    Proper (lentails --> lentails ++> lentails) limpl.
  Proof.
    intros P P' HP Q Q' HQ; red in HP.
    apply limplAdj; rewrite <- HQ, HP; apply landAdj; reflexivity.
  Qed.

  Global Instance limpl_lequiv_m:
    Proper (lequiv ==> lequiv ==> lequiv) limpl.
  Proof.
    intros P P' HP Q Q' HQ.
    split; apply limpl_lentails_m; (apply HP || apply HQ).
  Qed.

  Global Instance lpropand_lentails_m:
    Proper (impl ++> lentails ++> lentails) lpropand.
  Proof.
    intros p p' Hp Q Q' HQ.
    apply lexistsL; intro H. apply lexistsR; [apply Hp|]; assumption.
  Qed.

  Global Instance lpropand_lequiv_m:
    Proper (iff ==> lequiv ==> lequiv) lpropand.
  Proof.
    intros p p' Hp Q Q' HQ.
    split; cancel2; unfold impl; (apply Hp || apply HQ).
  Qed.

  Global Instance lpropimpl_lentails_m:
    Proper (impl --> lentails ++> lentails) lpropimpl.
  Proof.
    intros p p' Hp Q Q' HQ.
    apply lforallR; intro H. apply lforallL; [apply Hp|]; assumption.
  Qed.

  Global Instance lpropimpl_lequiv_m:
    Proper (iff ==> lequiv ==> lequiv) lpropimpl.
  Proof.
    intros p p' Hp Q Q' HQ.
    split; cancel2; unfold flip, impl; (apply Hp || apply HQ).
  Qed.

End ILogicMorphisms.

Section ILogicFacts.
  Context `{IL: ILogic Frm}.

  (* Experiments with proof search. *)
  Ltac landR :=
    repeat match goal with
    | |- _ |-- _ //\\ _ => apply landR
    end.

  Ltac landL :=
    repeat match goal with
    | |- ?L1 //\\ ?L2 |-- ?R =>
        match L1 with
        | context [R] => apply landL1
        | _ =>
          match L2 with
          | context [R] => apply landL2
          end
        end
    end.

  Lemma landC P Q: P //\\ Q -|- Q //\\ P.
  Proof. split; landR; landL; reflexivity. Qed.

  Lemma landA P Q R: (P //\\ Q) //\\ R -|- P //\\ (Q //\\ R).
  Proof. split; landR; landL; reflexivity. Qed.

  (* Derivable but useful *)
  Lemma lpropandTrue P : True /\\ P -|- P.
  Proof. unfold lpropand. split; [apply lexistsL | apply lexistsR]; trivial. Qed.

  Lemma lpropandFalse P : False /\\ P -|- lfalse.
  Proof. unfold lpropand. split; [apply lexistsL |]; intuition. Qed.

  (* Left-rule for limpl. This breaks the discipline of the ILogic presentation
     since the implication is not strictly the top symbol of the left-hand side,
     but it remains a convenient rule. *)
  Lemma limplL P Q CL CR (HP: CL |-- P) (HR: Q //\\ CL |-- CR) :
    (P -->> Q) //\\ CL |-- CR.
  Proof.
    rewrite <-HR, <-HP. apply landR; [apply landAdj |apply landL2]; reflexivity.
  Qed.

  Lemma lpropandL (p: Prop) Q C (H: p -> Q |-- C) :
    p /\\ Q |-- C.
  Proof. apply lexistsL; intro Hp. apply H; assumption. Qed.

  Lemma lpropandR C (p: Prop) Q (Hp: p) (HQ: C |-- Q) :
    C |-- p /\\ Q.
  Proof. apply lexistsR with Hp; assumption. Qed.

  Lemma lpropimplL (p: Prop) (Q C: Frm) (Hp: p) (HQ: Q |-- C) :
    p ->> Q |-- C.
  Proof. apply lforallL with Hp; assumption. Qed.

  Lemma lpropimplR C (p: Prop) Q (H: p -> C |-- Q) :
    C |-- p ->> Q.
  Proof. apply lforallR; intro Hp. apply H; assumption. Qed.

  (* Special case of limplAdj/landAdj when there is just ltrue on the lhs *)
  Lemma limplValid P Q:
    |-- P -->> Q <->
    P |-- Q.
  Proof.
    split; intro H.
    - etransitivity; [apply landR; [apply ltrueR|reflexivity]|].
      apply landAdj; assumption.
    - apply limplAdj. apply landL2; assumption.
  Qed.

  Lemma landexistsD {A} (f : A -> Frm) (P : Frm) :
    (Exists a, f a) //\\ P -|- Exists a, (f a //\\ P).
  Proof.
    split.
    + apply landAdj; apply lexistsL; intro a;
      apply limplAdj; apply lexistsR with a; reflexivity.
    + apply lexistsL; intro a; apply landR.
      - apply landL1; apply lexistsR with a; reflexivity.
      - apply landL2; reflexivity.
  Qed.

  Lemma landforallDL {A} (f : A -> Frm) (P : Frm) :
    (Forall a, f a) //\\ P |-- Forall a, (f a //\\ P).
  Proof.
    apply lforallR; intro a; apply landR.
    + apply landL1; apply lforallL with a; reflexivity.
    + apply landL2; reflexivity.
  Qed.

  Lemma landforallDR {A} {H: Inhabited A} (f : A -> Frm) (P : Frm) :
    Forall a, (f a //\\ P) |-- (Forall a, f a) //\\ P.
  Proof.
    apply landR.
    + apply lforallR; intro a; apply lforallL with a; apply landL1; reflexivity.
    + destruct H as [[a]]. apply lforallL with a; apply landL2; reflexivity.
  Qed.

  Lemma lpropandexistsD {A} (f : A -> Frm) (P : Prop) :
    P /\\ (Exists a, f a) -|- Exists a, (P /\\ f a).
  Proof.
    split.
    + apply lpropandL; intro HP; apply lexistsL; intro a.
      apply lexistsR with a; apply lpropandR; auto.
    + apply lexistsL; intro a; apply lpropandL; intro HP; apply lpropandR; [assumption|].
      apply lexistsR with a; reflexivity.
  Qed.

  Lemma lpropandforallDL {A} (f : A -> Frm) (P : Prop) :
    P /\\ (Forall a, f a) |-- Forall a, (P /\\ f a).
  Proof.
    apply lpropandL; intro HP; apply lforallR; intro a; apply lpropandR; [assumption|].
    apply lforallL with a; reflexivity.
  Qed.

  Lemma lpropandforallDR {A} {H: Inhabited A} (f : A -> Frm) (P : Prop) :
    Forall a, (P /\\ f a) |-- P /\\ (Forall a, f a).
  Proof.
    assert ((P /\\ ltrue) //\\ (Forall a, f a) |-- P /\\ (Forall a, f a)) as H0.
    + apply landAdj. apply lpropandL; intros HP. apply limplAdj; apply landL2.
      apply lpropandR; [assumption|].
      apply lforallR; intro a; apply lforallL with a; reflexivity.
    + rewrite <- H0; apply landR.
      - destruct H as [[a]]; apply lforallL with a;
        apply lpropandL; intros; apply lpropandR; auto.
      - apply lforallR; intro a; apply lforallL with a;
        apply lpropandL; intros; reflexivity.
  Qed.

End ILogicFacts.

(* Most of the connectives in ILogicOps are redundant. They can be derived from
   lexists, lforall and limpl, and the choice of limpl is unique up to lequiv
   since it is an adjoint. *)
Section ILogicEquiv.
  Context `{IL: ILogic Frm}.

  Section WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt_1.
  Import Ssreflect.ssreflect.

  Lemma land_is_forall P Q :
    P //\\ Q -|- Forall b : bool, if b then P else Q.
  Proof.
    split.
    - apply lforallR; intro x; destruct x.
      + apply landL1; reflexivity.
      + apply landL2; reflexivity.
    - apply landR.
      + apply lforallL with true; reflexivity.
      + apply lforallL with false; reflexivity.
  Qed.

  Lemma lor_is_exists P Q:
    P \\// Q -|- Exists b : bool, if b then P else Q.
  Proof.
    split.
    - apply lorL.
      + apply lexistsR with true; reflexivity.
      + apply lexistsR with false; reflexivity.
    - apply lexistsL; intro x; destruct x.
      + apply lorR1; reflexivity.
      + apply lorR2; reflexivity.
  Qed.
  End WeNeedSsreflectToGetTypingNotationsIfWeHaveRequiredIt_1.

  Lemma ltrue_is_forall:
    ltrue -|- Forall x: Empty_set, Empty_set_rect _ x.
  Proof. split; [apply lforallR|]; intuition. Qed.

  Lemma lfalse_is_exists:
    lfalse -|- Exists x: Empty_set, Empty_set_rect _ x.
  Proof. split; [|apply lexistsL]; intuition. Qed.

End ILogicEquiv.
(*
(* Tactics for doing forward reasoning from a hypothesis. *)
Lemma lforwardR {Frm} `{IL: ILogic Frm} P Q R:
  Q |-- R -> P |-- Q -> P |-- R.
Proof. intros; etransitivity; eassumption. Qed.
Tactic Notation "lforwardR" hyp(H) := eapply lforwardR in H; last first.

Lemma lforwardL {Frm} `{IL: ILogic Frm} P Q R:
  P |-- Q -> Q |-- R -> P |-- R.
Proof. intros; etransitivity; eassumption. Qed.
Tactic Notation "lforwardL" hyp(H) := eapply lforwardL in H; last first.

(* This tactic is a ilogic version of [move:]. Can it be done easier? *)
Ltac lrevert x :=
  move: x;
  match goal with
  | |- ?P -> _ |-- ?G =>
      move=> x;
      transitivity (P ->> G);
      [clear x | apply lpropimplL; [exact x|reflexivity] ]
  | |- forall a, _ |-- @?G a =>
      move=> x;
      transitivity (lforall G);
      [clear x | apply lforallL with x; reflexivity ]
  end.
*)

(* Given a pre-ordered type T and an intuitionistic logic with carrier Frm,
   the space of functions in [T -> Frm] that are monotone with respect to
   entailment is another intuitionistic logic. The semantics are standard
   Kripke semantics; i.e., all connectives are pointwise lifted from Frm,
   except implication, which is special. *)
Section ILogic_Pre.
  Context T (ord: relation T) {ord_Pre: PreOrder ord}.
  Context `{IL: ILogic Frm}.

  Record ILPreFrm := mkILPreFrm {
    ILPreFrm_pred :> T -> Frm;
    ILPreFrm_closed: forall t t': T, ord t t' ->
      ILPreFrm_pred t |-- ILPreFrm_pred t'
  }.

  Notation "'mk'" := @mkILPreFrm.

  Global Instance ILPreFrm_m (P: ILPreFrm): Proper (ord ++> lentails) P.
  Proof.
    intros t t' Ht. apply ILPreFrm_closed; assumption.
  Qed.

  Local Obligation Tactic :=
    repeat match goal with
    | |- ord _ _ -> _ => intros Hord; try setoid_rewrite Hord; reflexivity
    | |- _ => intro
    end.

  Program Definition ILPre_Ops : ILogicOps ILPreFrm := {|
    lentails P Q := forall t:T, P t |-- Q t;
    ltrue        := mk (fun t => ltrue) _;
    lfalse       := mk (fun t => lfalse) _;
    limpl    P Q := mk (fun t => Forall t', ord t t' ->> P t' -->> Q t') _;
    land     P Q := mk (fun t => P t //\\ Q t) _;
    lor      P Q := mk (fun t => P t \\// Q t) _;
    lforall  A P := mk (fun t => Forall a, P a t) _;
    lexists  A P := mk (fun t => Exists a, P a t) _
  |}.

  Local Existing Instance ILPre_Ops.

  Program Definition ILPre_ILogic : ILogic ILPreFrm.
  Proof.
    split; unfold lentails; simpl; intros.
    - split; red; [reflexivity|].
      intros P Q R HPQ HQR t. transitivity (Q t); [apply HPQ | apply HQR].
    - apply ltrueR.
    - apply lfalseL.
    - apply lforallL with x; apply H.
    - apply lforallR; intros; apply H.
    - apply lexistsL; intros; apply H.
    - apply lexistsR with x; apply H.
    - apply landL1; intuition.
    - apply landL2; intuition.
    - apply lorR1; intuition.
    - apply lorR2; intuition.
    - apply landR; intuition.
    - apply lorL; intuition.
    - apply landAdj.
      etransitivity; [apply H|]. clear H. apply lforallL with t.
      apply lpropimplL; reflexivity.
    - apply lforallR; intro t'. apply lpropimplR; intro Hord. apply limplAdj.
      rewrite ->Hord; intuition.
  Qed.

  Global Instance ILPreFrm_pred_m:
    Proper (lentails ++> ord ++> lentails) ILPreFrm_pred.
  Proof.
    intros P P' HP t t' Ht. rewrite ->Ht. apply HP.
  Qed.
End ILogic_Pre.

Implicit Arguments ILPreFrm [T [ILOps]].
Implicit Arguments mkILPreFrm [T ord Frm ILOps].

(** If [Frm] is a ILogic, then the function space [T -> Frm] is also an ilogic,
    for any type [T]. All connectives are just pointwise liftings. *)
Section ILogic_Fun.
  Context (T: Type) `{TType: type T}.
  Context `{IL: ILogic Frm}.

  Record ILFunFrm := mkILFunFrm {
    ILFunFrm_pred :> T -> Frm;
    ILFunFrm_closed: forall t t': T, t === t' ->
      ILFunFrm_pred t |-- ILFunFrm_pred t'
  }.

  Global Instance ILFunFrmEquiv {H: Equiv Frm} : Equiv ILFunFrm := {
     equiv p q := forall x, p x === q x
  }.

  Global Instance ILfunFrmType `{H: type Frm} : type ILFunFrm.
  Proof.
    split.
    + intros x y; reflexivity.
    + intros x y Hxy z; symmetry. apply Hxy.
    + intros x y z Hxy Hyz a; etransitivity;
      [apply Hxy | apply Hyz].
  Qed.

  Notation "'mk'" := @mkILFunFrm.

  Program Definition ILFun_Ops : ILogicOps ILFunFrm := {|
    lentails P Q := forall t:T, P t |-- Q t;
    ltrue        := mk (fun t => ltrue) _;
    lfalse       := mk (fun t => lfalse) _;
    limpl    P Q := mk (fun t => P t -->> Q t) _;
    land     P Q := mk (fun t => P t //\\ Q t) _;
    lor      P Q := mk (fun t => P t \\// Q t) _;
    lforall  A P := mk (fun t => Forall a, P a t) _;
    lexists  A P := mk (fun t => Exists a, P a t) _
  |}.
  Next Obligation.
    apply limplAdj.
    rewrite <- ILFunFrm_closed; [|symmetry; eassumption].
    apply limplL; [reflexivity| apply landL1; apply ILFunFrm_closed; assumption].
  Qed.
  Next Obligation.
    apply landR; [apply landL1 | apply landL2]; apply ILFunFrm_closed; assumption.
  Qed.
  Next Obligation.
    apply lorL; [apply lorR1 | apply lorR2]; apply ILFunFrm_closed; assumption.
  Qed.
  Next Obligation.
    apply lforallR; intro a; apply lforallL with a; apply ILFunFrm_closed; assumption.
  Qed.
  Next Obligation.
    apply lexistsL; intro a; apply lexistsR with a; apply ILFunFrm_closed; assumption.
  Qed.

  Local Existing Instance ILFun_Ops.

  Program Definition ILFun_ILogic : ILogic ILFunFrm.
  Proof.
    split; unfold lentails; simpl; intros.
    - split; red; [reflexivity|].
      intros P Q R HPQ HQR t. transitivity (Q t); [apply HPQ | apply HQR].
    - apply ltrueR.
    - apply lfalseL.
    - apply lforallL with x; apply H.
    - apply lforallR; intros; apply H.
    - apply lexistsL; intros; apply H.
    - apply lexistsR with x; apply H.
    - apply landL1; intuition.
    - apply landL2; intuition.
    - apply lorR1; intuition.
    - apply lorR2; intuition.
    - apply landR; intuition.
    - apply lorL; intuition.
    - apply landAdj; intuition.
    - apply limplAdj; intuition.
  Qed.

End ILogic_Fun.

Implicit Arguments ILFunFrm [[ILOps] [e]].
Implicit Arguments mkILFunFrm [T Frm ILOps].

Local Existing Instance ILFun_Ops.
Local Existing Instance ILFun_ILogic.

Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) :
  @ILFunFrm T _ R ILOps :=
  @mkILFunFrm T eq R ILOps P _.
Next Obligation.
  destruct H; simpl; reflexivity.
Qed.

(* Prop is an intuitionistic logic *)
Instance ILogicOps_Prop : ILogicOps Prop | 2 := {|
  lentails P Q := P -> Q;
  ltrue        := True;
  lfalse       := False;
  limpl    P Q := P -> Q;
  land     P Q := P /\ Q;
  lor      P Q := P \/ Q;
  lforall  T F := forall x:T, F x;
  lexists  T F := exists x:T, F x
|}.

Instance ILogic_Prop : ILogic Prop.
Proof.
  split; cbv; firstorder.
Qed.

(* Make the setoid system realize that these two are the same thing (in the
   direction that seems useful. *)
Instance: subrelation lentails Basics.impl.
Proof. reflexivity. Qed.
Instance: subrelation (Basics.flip lentails) (Basics.flip Basics.impl).
Proof. reflexivity. Qed.

(* It does not seem possible to add a morphism that applies to an arbitrary
   function application. This is sometimes needed when we make a logic out of a
   function space, so the workaround is to rewrite by this lemma. *)
(*
Lemma lentails_eq T `{HT: type T} (P: ILFunFrm T Prop) t:
  P t <-> equiv t |-- P.
Proof.
  split.
  - simpl. intros; subst; assumption.
  - simpl. intros; firstorder.
Qed.

Lemma ILFun_exists_eq T (P: T -> Prop):
  P -|- Exists s, P s /\\ eq s.
Proof.
  split; intros s Hs.
  - exists s. constructor; intuition.
  - firstorder; subst; assumption.
Qed.
*)

(** NOTE(JasonGross): The type of this lemma was derived by carefully
                      inspecting the output of a [setoid_rewrite]
                      failure with [Typeclasses eauot := debug] and
                      [Set Printing Implicit].  There's probably a
                      nicer way to phrase it, but it lets us do
                      [setoid_rewrite] with a functional [lentails]
                      treated as an implication.  Magic! *)

Global Instance lentails_sub_impl T e `{@csetoid.type T e} `{ILogicOps (@ILFunFrm T e Prop ILogicOps_Prop)}
: @Proper
    (@ILFunFrm T e Prop _ -> T -> Prop)
    (@lentails _ (@ILFun_Ops T e _ Prop ILogicOps_Prop ILogic_Prop) ==> @eq T ==> impl)
    (@ILFunFrm_pred T e Prop ILogicOps_Prop).
Proof. intros x y H' x' y' H''; subst. exact (H' _). Qed.

Global Instance lequiv_sub_iff T e `{@csetoid.type T e} `{ILogicOps (@ILFunFrm T e Prop ILogicOps_Prop)}
: @Proper
    (@ILFunFrm T e Prop _ -> T -> Prop)
    (@lequiv _ (@ILFun_Ops T e _ Prop ILogicOps_Prop ILogic_Prop) ==> @eq T ==> iff)
    (@ILFunFrm_pred T e Prop ILogicOps_Prop).
Proof. intros x y [H'1 H'2] x' y' H''; subst. split; [ exact (H'1 _) | exact (H'2 _) ]. Qed.

Global Instance lequiv_sub_impl T e `{@csetoid.type T e} `{ILogicOps (@ILFunFrm T e Prop ILogicOps_Prop)}
: @Proper
    (@ILFunFrm T e Prop _ -> T -> Prop)
    (@lequiv _ (@ILFun_Ops T e _ Prop ILogicOps_Prop ILogic_Prop) ==> @eq T ==> impl)
    (@ILFunFrm_pred T e Prop ILogicOps_Prop).
Proof. intros x y [H'1 H'2] x' y' H''; subst. exact (H'1 _). Qed.

Global Instance lequiv_sub_flip_impl T e `{@csetoid.type T e} `{ILogicOps (@ILFunFrm T e Prop ILogicOps_Prop)}
: @Proper
    (@ILFunFrm T e Prop _ -> T -> Prop)
    (@lequiv _ (@ILFun_Ops T e _ Prop ILogicOps_Prop ILogic_Prop) ==> @eq T ==> flip impl)
    (@ILFunFrm_pred T e Prop ILogicOps_Prop).
Proof. intros x y [H'1 H'2] x' y' H''; subst. exact (H'2 _). Qed.

(* Coq tends to unfold lentails on [simpl], which triggers unfolding of
   several other connectives. When that happens, the goal can become quite
   unreadable. The workaround is to make the definition of entailment and
   connectives opaque. If a module wants to unfold those definitions, it should
   do [Transparent IL?_Ops], where ? is Pre or Fun. *)

Global Opaque ILPre_Ops.
Global Opaque ILFun_Ops.
(** We make these connectives [Opaque] to speed up unification and [apply] *)
Global Opaque lentails ltrue lfalse limpl land lor lforall lexists.


From isla Require Import opsem.

Definition a64 : isla_trace :=
  Smt (DeclareConst 0%Z (Ty_BitVec 64%N)) Mk_annot :t:
  Assume (AExp_Binop (Eq) (AExp_Unop (Extract 1%N 1%N) (AExp_Val (AVal_Var "PC" []) Mk_annot) Mk_annot) (AExp_Val (AVal_Bits (BV 1%N 0x0%Z)) Mk_annot) Mk_annot) Mk_annot :t:
  ReadReg "PC" [] (RegVal_Base (Val_Symbolic 0%Z)) Mk_annot :t:
  Smt (DefineConst 1%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  Smt (DeclareConst 13%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "x10" [] (RegVal_Base (Val_Symbolic 13%Z)) Mk_annot :t:
  Smt (DefineConst 14%Z (Binop (Eq) (Val (Val_Symbolic 13%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x0%Z)) Mk_annot) Mk_annot)) Mk_annot :t:
  Smt (DefineConst 15%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0xffffffffffffffd8%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  tcases [
    Smt (Assert (Val (Val_Symbolic 14%Z) Mk_annot)) Mk_annot :t:
    Smt (DefineConst 16%Z (Unop (Extract 0%N 0%N) (Binop ((Bvarith Bvlshr)) (Val (Val_Symbolic 15%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x1%Z)) Mk_annot) Mk_annot) Mk_annot)) Mk_annot :t:
    BranchAddress (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    tnil;
    Smt (Assert (Unop (Not) (Val (Val_Symbolic 14%Z) Mk_annot) Mk_annot)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 1%Z)) Mk_annot :t:
    tnil
  ]
.


(** printing ⊢k #⊢k# *)
(** printing ⊢! #⊢# *)
(** printing k⊣ #⊣# *)
(** printing |- #⊢# *)
(** printing ⦂ #:# *)
(** printing <⦂ #<:# *)
(** printing [<=] #⊆# *)
(** printing `union` #∪# *)
(** printing \u #∪# *)
(** printing `notin` #∉# *)
(** printing `in` #∈# *)
(** printing ⊆<⦂ #⊆<:# *)

Set Implicit Arguments.

Require Export StdSetup.
Require Export VarDef.

Hint Rewrite -> AtomSetProperties.add_union_singleton : meta_ext.

(** * Abstract Syntax *)

(** ** Types
    - [typ_top] represents the [⊤] type.
    - [typ_bot] represents the [⊥] type.
    - [typ_sel x] represents a path dependent type [x.A].
    - [typ_all S U] represents a dependent function type [∀(x: S)U].
    - [typ_bnd S U] represents a type declaration [{ A : S .. U }].
 *)

Inductive typ : Set :=
| typ_top : typ
| typ_bot : typ
| typ_sel : avar -> typ
| typ_all : typ -> typ -> typ
| typ_bnd :  typ -> typ -> typ.
Hint Constructors typ.

Instance EqDecTyp : EqDec_eq typ := { }.
Proof.
  intros; decide equality.
  destruct (a == a0); auto.
Defined.

(** ** Terms and Values
    Terms are represented by the following syntax:
    - [trm_var x] represents variable [x] as a term.
    - [trm_val v] represents value [v] as a term.
    - [trm_app x y] represents a function application, where x is treated to be a function.
    - [trm_let t u] represents a let binding [let x = t in u].

    Values are represented by the following syntax:
    - [val_bnd T] represents a type tag [{ A = T }].
    - [val_lam T t] represents a lambda expression [λ(x : T) t].
 *)

Inductive trm : Set :=
| trm_var : avar -> trm
| trm_val : val -> trm
| trm_app : avar -> avar -> trm
| trm_let : trm -> trm -> trm
with
val : Set :=
| val_bnd : typ -> val
| val_lam : typ -> trm -> val.

Hint Constructors trm val.

(** * Basic Characteristics

    Here we define some basic characteristics of the abstract syntax, including local
 closure, the opening, closing and substitution operations, and the retrieval of free
 variables of variables, types, terms and values.

 This library uses a number of type classes to capture these characteristics,
 including [LC], [CanOpen], [CanClose] and [HasFv]. Thus, each characteristic can be
 represented by one single predicate.  *)
Section LocalClosure.

  Inductive lc_avar_at : nat -> avar -> Prop :=
  | lc_ab : forall {n m}, n < m -> lc_avar_at m (avar_b n)
  | lc_af : forall {n x}, lc_avar_at n (avar_f x).

  Global Instance LcAvar : LC avar := { lc_at := lc_avar_at }.

  Inductive lc_typ_at : nat -> typ -> Prop :=
  | lc_typ_top : forall {n}, lc_typ_at n typ_top
  | lc_typ_bot : forall {n}, lc_typ_at n typ_bot
  | lc_typ_sel : forall {n v}, lc_at n v -> lc_typ_at n (typ_sel v)
  | lc_typ_all : forall {n T U}, lc_typ_at n T -> lc_typ_at (S n) U ->
                            lc_typ_at n (typ_all T U)
  | lc_typ_bnd : forall {n S U}, lc_typ_at n S -> lc_typ_at n U ->
                            lc_typ_at n (typ_bnd S U).

  Global Instance LcTyp : LC typ := { lc_at := lc_typ_at }.

  Inductive lc_trm_at : nat -> trm -> Prop :=
  | lc_trm_var : forall {n v}, lc_at n v -> lc_trm_at n (trm_var v)
  | lc_trm_val : forall {n vl}, lc_val_at n vl -> lc_trm_at n (trm_val vl)
  | lc_trm_app : forall {n x y}, lc_at n x -> lc_at n y -> lc_trm_at n (trm_app x y)
  | lc_trm_let : forall {n t1 t2}, lc_trm_at n t1 -> lc_trm_at (S n) t2 ->
                              lc_trm_at n (trm_let t1 t2)
  with
  lc_val_at : nat -> val -> Prop :=
  | lc_val_bnd : forall {n T}, lc_at n T -> lc_val_at n (val_bnd T)
  | lc_val_lam : forall {n T t}, lc_at n T -> lc_trm_at (S n) t ->
                            lc_val_at n (val_lam T t).

  Global Instance LcTrm : LC trm := { lc_at := lc_trm_at }.
  Global Instance LcVal : LC val := { lc_at := lc_val_at }.

End LocalClosure.

Hint Constructors lc_avar_at lc_typ_at lc_trm_at lc_val_at.

Section OpeningDefinitions.

  Definition open_rec_avar (k : nat) (u : var) (a : avar) : avar :=
    match a with
    | avar_b i => if k == i then avar_f u else avar_b i
    | avar_f x => avar_f x
    end.

  Fixpoint open_rec_typ (k : nat) (u : var) (T : typ) : typ :=
    match T with
    | typ_top => typ_top
    | typ_bot => typ_bot
    | typ_sel x => typ_sel $ open_rec_avar k u x
    | typ_all T U => typ_all (open_rec_typ k u T) $ open_rec_typ (S k) u U
    | typ_bnd T U => typ_bnd (open_rec_typ k u T) $ open_rec_typ k u U
    end.

  Fixpoint open_rec_trm k u (t : trm) : trm :=
    match t with
    | trm_var x => trm_var $ open_rec_avar k u x
    | trm_val v => trm_val $ open_rec_val k u v
    | trm_app x y => trm_app (open_rec_avar k u x) $ open_rec_avar k u y
    | trm_let s t => trm_let (open_rec_trm k u s) $ open_rec_trm (S k) u t
    end
  with
  open_rec_val k u (vl : val) : val :=
    match vl with
    | val_bnd T => val_bnd $ open_rec_typ k u T
    | val_lam T t => val_lam (open_rec_typ k u T) $ open_rec_trm (S k) u t
    end.

  Global Instance OpenAvar : CanOpen avar := { open_rec := open_rec_avar }.
  Global Instance OpenTyp : CanOpen typ := { open_rec := open_rec_typ }.
  Global Instance OpenTrm : CanOpen trm := { open_rec := open_rec_trm }.
  Global Instance OpenVal : CanOpen val := { open_rec := open_rec_val }.

End OpeningDefinitions.

Section ClosingDefinitions.

  Definition close_rec_avar (k : nat) (u : var) (a : avar) : avar :=
    match a with
    | avar_b n => avar_b n
    | avar_f x => if x == u then avar_b k else avar_f x
    end.

  Fixpoint close_rec_typ (k : nat) (u : var) (T : typ) : typ :=
    match T with
    | typ_top => typ_top
    | typ_bot => typ_bot
    | typ_sel x => typ_sel $ close_rec_avar k u x
    | typ_all T U => typ_all (close_rec_typ k u T) $ close_rec_typ (S k) u U
    | typ_bnd T U => typ_bnd (close_rec_typ k u T) $ close_rec_typ k u U
    end.

  Fixpoint close_rec_trm k u (t : trm) : trm :=
    match t with
    | trm_var x => trm_var $ close_rec_avar k u x
    | trm_val v => trm_val $ close_rec_val k u v
    | trm_app x y => trm_app (close_rec_avar k u x) $ close_rec_avar k u y
    | trm_let s t => trm_let (close_rec_trm k u s) $ close_rec_trm (S k) u t
    end
  with
  close_rec_val k u (vl : val) : val :=
    match vl with
    | val_bnd T => val_bnd $ close_rec_typ k u T
    | val_lam T t => val_lam (close_rec_typ k u T) $ close_rec_trm (S k) u t
    end.

  Global Instance CloseAvar : CanClose avar := { close_rec := close_rec_avar }.
  Global Instance CloseTyp : CanClose typ := { close_rec := close_rec_typ }.
  Global Instance CloseTrm : CanClose trm := { close_rec := close_rec_trm }.
  Global Instance CloseVal : CanClose val := { close_rec := close_rec_val }.

End ClosingDefinitions.

Section Substitutions.

  Definition subst_avar (z u: var) (a : avar) : avar :=
    match a with
    | avar_b i as a => a
    | avar_f x => avar_f $ if x == z then u else x
    end.

  Fixpoint subst_typ (z u: var) (T : typ) : typ :=
    match T with
    | typ_top => typ_top
    | typ_bot => typ_bot
    | typ_sel x => typ_sel (subst_avar z u x)
    | typ_all T U => typ_all (subst_typ z u T) (subst_typ z u U)
    | typ_bnd T U => typ_bnd (subst_typ z u T) (subst_typ z u U)
    end.

  Fixpoint subst_trm (z u: var) (t : trm) : trm :=
    match t with
    | trm_var x => trm_var $ subst_avar z u x
    | trm_val v => trm_val $ subst_val z u v
    | trm_app x y => trm_app (subst_avar z u x) $ subst_avar z u y
    | trm_let t1 t2 => trm_let (subst_trm z u t1) $ subst_trm z u t2
    end
  with
  subst_val (z u: var) (v : val) : val :=
    match v with
    | val_bnd T => val_bnd $ subst_typ z u T
    | val_lam T t => val_lam (subst_typ z u T) (subst_trm z u t)
    end.

  Global Instance SubstAvar : CanSubst avar := { substi := subst_avar }.
  Global Instance SubstTyp : CanSubst typ := { substi := subst_typ }.
  Global Instance SubstTrm : CanSubst trm := { substi := subst_trm }.
  Global Instance SubstVal : CanSubst val := { substi := subst_val }.

End Substitutions.

Notation env := (list (var * typ)).

Section FreeVariables.

  Definition fv_avar (v : avar) : vars :=
    match v with
    | avar_b _ => {}
    | avar_f x => {{ x }}
    end.

  Local Ltac empty := exact {}.
  Local Ltac singleton :=
    apply fv_avar; assumption.
  Local Ltac recur f :=
    apply f; assumption.
  Local Ltac recur2 f :=
    lazymatch type of f with
    | forall _: ?T, _ =>
      lazymatch goal with
      | T1 : T, T2 : T |- vars =>
        exact (f T1 \u f T2)
      end
    end.

  Fixpoint fv_typ (T : typ) : vars :=
    match T with
    | typ_top | typ_bot => {}
    | typ_sel _ => ltac:(singleton)
    | typ_all _ _ | typ_bnd _ _ => ltac:(recur2 fv_typ)
    end.

  Fixpoint fv_trm (t : trm) : vars :=
    match t with
    | trm_var _ => ltac:(singleton)
    | trm_val _ => ltac:(recur fv_val)
    | trm_app x y => fv_avar x \u fv_avar y
    | trm_let _ _ => ltac:(recur2 fv_trm)
    end
  with
  fv_val (vl : val) : vars :=
    match vl with
    | val_bnd _ => ltac:(recur fv_typ)
    | val_lam T t => fv_typ T \u fv_trm t
    end.

  Global Instance FvAvar : HasFv avar := { fv := fv_avar }.
  Global Instance FvTyp : HasFv typ := { fv := fv_typ }.
  Global Instance FvTrm : HasFv trm := { fv := fv_trm }.
  Global Instance FvVal : HasFv val := { fv := fv_val }.

  Global Instance FvEnv : HasFv env := { fv := fun e => dom e `union` fv_values fv e }.

  Lemma fv_union : forall (e1 e2 : env) , fv (e1 ++ e2) [=] fv e1 `union` fv e2.
  Proof.
    intros; simpl.
    apply AtomSetProperties.subset_antisym;
      set solve.
  Qed.

End FreeVariables.

Hint Rewrite -> fv_union : meta_ext.

Ltac gather_atoms ::=
  let A := gather_atoms_with (fun x : atoms => x) in
  let B := gather_atoms_with (fun x : atom => singleton x) in
  let C := gather_atoms_with (fun x : env => fv x) in
  let D := gather_atoms_with fv_avar in
  let E := gather_atoms_with fv_typ in
  let F := gather_atoms_with fv_trm in
  let G := gather_atoms_with fv_val in
  constr:(A `union` B `union` C `union` D `union` E `union` F `union` G).

Reserved Notation "G ⊢ t ⦂ T" (at level 90).
Reserved Notation "G ⊢ S <⦂ U" (at level 90).

(** * Type Assigment and Subtyping
 *)

(** The type assignment judgment [G ⊢ t : T]: *)
Inductive typing : env -> trm -> typ -> Prop :=
(** [――――――――――――] Var #
#
    [G ⊢ x : G(x)]  *)
| ty_var : forall {G v T},
    binds v T G ->
    G ⊢ trm_var $ avar_f v ⦂ T
(** [――――――――――――――――――――――――――――――] Typ-I #
#
    [G ⊢ { A = T } : { A : T .. T }]  *)
| ty_bnd : forall G T,
    G ⊢ trm_val $ val_bnd T ⦂ typ_bnd T T
(** [G; x : S ⊢ t : U]
    [――――――――――――――――] All-I #
#
    [G ⊢ λ(x : S)t : ∀(x : S)U]  *)
| ty_lam : forall {L G S U t},
    (forall x, x \notin L ->
          x ~ S ++ G ⊢ open x t ⦂ open x U) ->
    G ⊢ trm_val $ val_lam S t ⦂ typ_all S U
(** [G ⊢ x : ∀(z : S)U] #
#
    [G ⊢ y : S] #
#
    [―――――――――――――――――――――――――] All-E #
#
    [G ⊢ λ(x : S)t : ∀(x : S)U]  *)
| ty_app : forall {G S U x y},
    G ⊢ trm_var $ avar_f x ⦂ typ_all S U ->
    G ⊢ trm_var $ avar_f y ⦂ S ->
    G ⊢ (trm_app (avar_f x) $ avar_f y) ⦂ open y U
(** [G ⊢ s : S] #
#
    [G; x : S ⊢ u : U (x ∉ fv(U))] #
#
    [――――――――――――――――――――――――――――] Let #
#
    [G ⊢ let x  = s in u : U]  *)
| ty_let : forall {L G s S u U},
    G ⊢ s ⦂ S ->
    (forall x, x \notin L -> x ~ S ++ G ⊢ open x u ⦂ U) ->
    G ⊢ trm_let s u ⦂ U
(** [G ⊢ x : S] #
#
    [G ⊢ S <: U] #
#
    [――――――――――] Sub #
#
    [G ⊢ x : U]  *)
| ty_sub : forall {G t S U},
    G ⊢ t ⦂ S ->
    G ⊢ S <⦂ U ->
    G ⊢ t ⦂ U
where "G ⊢ t ⦂ T" := (typing G t T)
with
(** The subtyping judgment [G ⊢ S <: U]: *)
subty : env -> typ -> typ -> Prop :=
(** [――――――――――] Refl #
#
    [G ⊢ T <: T]  *)
| st_refl : forall G T,
    G ⊢ T <⦂ T
(** [――――――――――] Top #
#
    [G ⊢ T <: ⊤]  *)
| st_top : forall G T,
    G ⊢ T <⦂ typ_top
(** [――――――――――] Bot #
#
    [G ⊢ ⊥ <: T]  *)
| st_bot : forall G T,
    G ⊢ typ_bot <⦂ T
(** [G ⊢ S <: T] #
#
    [G ⊢ T <: U] #
#
    [――――――――――] Trans #
#
    [G ⊢ S <: U]  *)
| st_trans : forall {G S T U},
    G ⊢ S <⦂ T ->
    G ⊢ T <⦂ U ->
    G ⊢ S <⦂ U
(** [G ⊢ S <: T1] #
#
    [G ⊢ T2 <: U] #
#
    [――――――――――――――――――――――――――――――――――――――] Bnd #
#
    [G ⊢ { A : T1 .. T2 } <: { A : S .. U }]  *)
| st_bnd : forall {G S T1 T2 U},
    G ⊢ S <⦂ T1 ->
    G ⊢ T2 <⦂ U ->
    G ⊢ typ_bnd T1 T2 <⦂ typ_bnd S U
(** [G ⊢ S2 <: S1] #
#
    [G; x : S2 ⊢ U1 <: U2] #
#
    [――――――――――――――――――――――――――――――] All #
#
    [G ⊢ ∀(x : S1)U1 <: ∀(x : S2)U2]  *)
| st_all : forall {L G S1 S2 U1 U2},
    G ⊢ S2 <⦂ S1 ->
    (forall x, x \notin L -> x ~ S2 ++ G ⊢ open x U1 <⦂ open x U2) ->
    G ⊢ typ_all S1 U1 <⦂ typ_all S2 U2
(** [G ⊢ x <: { A : S .. U }] #
#
    [―――――――――――――――――――――――] Sel1 #
#
    [G ⊢ S <: x.A]  *)
| st_sel1 : forall {G x S U},
    G ⊢ trm_var $ avar_f x ⦂ typ_bnd S U ->
    G ⊢ S <⦂ typ_sel $ avar_f x
(** [G ⊢ x <: { A : S .. U }] #
#
    [―――――――――――――――――――――――] Sel2 #
#
    [G ⊢ x.A <: U]  *)
| st_sel2 : forall {G x S U},
    G ⊢ trm_var $ avar_f x ⦂ typ_bnd S U ->
    G ⊢ typ_sel $ avar_f x <⦂ U
where "G ⊢ S <⦂ U" := (subty G S U).
Hint Constructors typing subty.
(** removing this rule from hintbase to avoid unexpected subsumption. *)
Remove Hints ty_sub.