Remove unnecessary usage of Equations
This commit is contained in:
parent
9a52ab334f
commit
ee7be7584c
1 changed files with 47 additions and 82 deletions
|
@ -8,9 +8,6 @@ Require Import Psatz.
|
||||||
From stdpp Require Import relations (rtc (..), rtc_once, rtc_r).
|
From stdpp Require Import relations (rtc (..), rtc_once, rtc_r).
|
||||||
From Hammer Require Import Tactics.
|
From Hammer Require Import Tactics.
|
||||||
Require Import Autosubst2.core Autosubst2.fintype Autosubst2.syntax.
|
Require Import Autosubst2.core Autosubst2.fintype Autosubst2.syntax.
|
||||||
From Equations Require Import Equations.
|
|
||||||
|
|
||||||
Unset Equations With Funext.
|
|
||||||
|
|
||||||
Ltac2 spec_refl () :=
|
Ltac2 spec_refl () :=
|
||||||
List.iter
|
List.iter
|
||||||
|
@ -1062,58 +1059,46 @@ Definition prov_univ {n} i0 (a : Tm n) :=
|
||||||
end.
|
end.
|
||||||
|
|
||||||
(* Can consider combine prov and provU *)
|
(* Can consider combine prov and provU *)
|
||||||
#[tactic="prov_tac"]Equations prov {n} (h : Tm n) (a : Tm n) : Prop by wf (depth_tm a) lt :=
|
Fixpoint prov {n} (h : Tm n) (a : Tm n) : Prop :=
|
||||||
prov h (TBind p0 A0 B0) := prov_bind p0 A0 B0 h;
|
match a with
|
||||||
prov h (Abs a) := prov (ren_Tm shift h) a;
|
| (TBind p0 A0 B0) => prov_bind p0 A0 B0 h
|
||||||
prov h (App a b) := prov h a;
|
| (Abs a) => prov (ren_Tm shift h) a
|
||||||
prov h (Pair a b) := prov h a /\ prov h b;
|
| (App a b) => prov h a
|
||||||
prov h (Proj p a) := prov h a;
|
| (Pair a b) => prov h a /\ prov h b
|
||||||
prov h Bot := False;
|
| (Proj p a) => prov h a
|
||||||
prov h (VarTm _) := False;
|
| Bot => False
|
||||||
prov h (Univ i) := prov_univ i h .
|
| VarTm _ => False
|
||||||
|
| Univ i => prov_univ i h
|
||||||
|
end.
|
||||||
|
|
||||||
#[tactic="prov_tac"]Equations extract {n} (a : Tm n) : Tm n by wf (depth_tm a) lt :=
|
Fixpoint extract {n} (a : Tm n) : Tm n :=
|
||||||
extract (TBind p A B) := TBind p A B;
|
match a with
|
||||||
extract (Abs a) := subst_Tm (scons Bot VarTm) (extract a);
|
| TBind p A B => TBind p A B
|
||||||
extract (App a b) := extract a;
|
| Abs a => subst_Tm (scons Bot VarTm) (extract a)
|
||||||
extract (Pair a b) := extract a;
|
| App a b => extract a
|
||||||
extract (Proj p a) := extract a;
|
| Pair a b => extract a
|
||||||
extract Bot := Bot;
|
| Proj p a => extract a
|
||||||
extract (VarTm i) := (VarTm i);
|
| Bot => Bot
|
||||||
extract (Univ i) := Univ i.
|
| VarTm i => VarTm i
|
||||||
|
| Univ i => Univ i
|
||||||
|
end.
|
||||||
|
|
||||||
Lemma ren_extract n m (a : Tm n) (ξ : fin n -> fin m) :
|
Lemma ren_extract n m (a : Tm n) (ξ : fin n -> fin m) :
|
||||||
extract (ren_Tm ξ a) = ren_Tm ξ (extract a).
|
extract (ren_Tm ξ a) = ren_Tm ξ (extract a).
|
||||||
Proof.
|
Proof.
|
||||||
move : m ξ. elim : n/a.
|
move : m ξ. elim : n/a.
|
||||||
- sfirstorder.
|
- sfirstorder.
|
||||||
- move => n a ih m ξ. simpl.
|
- move => n a ih m ξ /=.
|
||||||
simp extract.
|
|
||||||
rewrite ih.
|
rewrite ih.
|
||||||
by asimpl.
|
by asimpl.
|
||||||
- hauto q:on rew:db:extract.
|
- hauto q:on.
|
||||||
- hauto q:on rew:db:extract.
|
- hauto q:on.
|
||||||
- hauto q:on rew:db:extract.
|
- hauto q:on.
|
||||||
- hauto q:on rew:db:extract.
|
- hauto q:on.
|
||||||
- sfirstorder.
|
- sfirstorder.
|
||||||
- sfirstorder.
|
- sfirstorder.
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Lemma tm_depth_ind (P : forall n, Tm n -> Prop) :
|
|
||||||
(forall n (a : Tm n), (forall m (b : Tm m), depth_tm b < depth_tm a -> P m b) -> P n a) -> forall n a, P n a.
|
|
||||||
Proof.
|
|
||||||
move => ih.
|
|
||||||
suff : forall m n (a : Tm n), depth_tm a <= m -> P n a by sfirstorder.
|
|
||||||
elim.
|
|
||||||
- move => n a h.
|
|
||||||
apply ih. lia.
|
|
||||||
- move => n ih0 m a h.
|
|
||||||
apply : ih.
|
|
||||||
move => m0 b h0.
|
|
||||||
apply : ih0.
|
|
||||||
lia.
|
|
||||||
Qed.
|
|
||||||
|
|
||||||
Lemma prov_bind_ren n m p (A : Tm n) B (ξ : fin n -> fin m) a :
|
Lemma prov_bind_ren n m p (A : Tm n) B (ξ : fin n -> fin m) a :
|
||||||
prov_bind p A B a ->
|
prov_bind p A B a ->
|
||||||
prov_bind p (ren_Tm ξ A) (ren_Tm (upRen_Tm_Tm ξ) B) (ren_Tm ξ a).
|
prov_bind p (ren_Tm ξ A) (ren_Tm (upRen_Tm_Tm ξ) B) (ren_Tm ξ a).
|
||||||
|
@ -1125,23 +1110,17 @@ Qed.
|
||||||
Lemma prov_ren n m (ξ : fin n -> fin m) h a :
|
Lemma prov_ren n m (ξ : fin n -> fin m) h a :
|
||||||
prov h a -> prov (ren_Tm ξ h) (ren_Tm ξ a).
|
prov h a -> prov (ren_Tm ξ h) (ren_Tm ξ a).
|
||||||
Proof.
|
Proof.
|
||||||
move : m ξ h. elim : n / a.
|
move : m ξ h. elim : n / a => //=.
|
||||||
- sfirstorder rew:db:prov.
|
|
||||||
- move => n a ih m ξ h.
|
- move => n a ih m ξ h.
|
||||||
simp prov.
|
|
||||||
move /ih => {ih}.
|
move /ih => {ih}.
|
||||||
move /(_ _ (upRen_Tm_Tm ξ)) => /=.
|
move /(_ _ (upRen_Tm_Tm ξ)) => /=.
|
||||||
simp prov.
|
|
||||||
move => h0.
|
move => h0.
|
||||||
suff : ren_Tm (upRen_Tm_Tm ξ) (ren_Tm shift h) = ren_Tm shift (ren_Tm ξ h) by move => <-.
|
suff : ren_Tm (upRen_Tm_Tm ξ) (ren_Tm shift h) = ren_Tm shift (ren_Tm ξ h) by move => <-.
|
||||||
clear.
|
clear.
|
||||||
case : h => * /=; by asimpl.
|
case : h => * /=; by asimpl.
|
||||||
- hauto q:on rew:db:prov.
|
- hauto l:on.
|
||||||
- qauto l:on rew:db:prov.
|
- hauto l:on use:prov_bind_ren.
|
||||||
- hauto lq:on rew:db:prov.
|
- hauto lq:on inv:Tm.
|
||||||
- hauto l:on use:prov_bind_ren rew:db:prov.
|
|
||||||
- sfirstorder.
|
|
||||||
- hauto l:on inv:Tm rew:db:prov.
|
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Definition hfb {n} (a : Tm n) :=
|
Definition hfb {n} (a : Tm n) :=
|
||||||
|
@ -1156,22 +1135,17 @@ Lemma prov_morph n m (ρ : fin n -> Tm m) h a :
|
||||||
hfb h ->
|
hfb h ->
|
||||||
prov (subst_Tm ρ h) (subst_Tm ρ a).
|
prov (subst_Tm ρ h) (subst_Tm ρ a).
|
||||||
Proof.
|
Proof.
|
||||||
move : m ρ h. elim : n / a.
|
move : m ρ h. elim : n / a => //=.
|
||||||
- hauto q:on rew:db:prov.
|
|
||||||
- move => n a ih m ρ h + hb.
|
- move => n a ih m ρ h + hb.
|
||||||
simp prov => /=.
|
|
||||||
move /ih => {ih}.
|
move /ih => {ih}.
|
||||||
move /(_ _ (up_Tm_Tm ρ) ltac:(hauto lq:on inv:Tm)).
|
move /(_ _ (up_Tm_Tm ρ) ltac:(hauto lq:on inv:Tm)).
|
||||||
simp prov. by asimpl.
|
by asimpl.
|
||||||
- hauto q:on rew:db:prov.
|
- hauto q:on.
|
||||||
- hauto q:on rew:db:prov.
|
- move => n p A ihA B ihB m ρ h /=. move => //= + h0.
|
||||||
- hauto lq:on rew:db:prov.
|
|
||||||
- move => n p A ihA B ihB m ρ h /=. simp prov => //= + h0.
|
|
||||||
case : h h0 => //=.
|
case : h h0 => //=.
|
||||||
move => p0 A0 B0 _ [? [h1 h2]]. subst.
|
move => p0 A0 B0 _ [? [h1 h2]]. subst.
|
||||||
hauto l:on use:Pars.substing rew:db:prov.
|
hauto l:on use:Pars.substing.
|
||||||
- qauto rew:db:prov.
|
- hauto l:on inv:Tm.
|
||||||
- hauto l:on inv:Tm rew:db:prov.
|
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Lemma ren_hfb {n m} (ξ : fin n -> fin m) u : hfb (ren_Tm ξ u) = hfb u.
|
Lemma ren_hfb {n m} (ξ : fin n -> fin m) u : hfb (ren_Tm ξ u) = hfb u.
|
||||||
|
@ -1182,9 +1156,8 @@ Hint Rewrite @ren_hfb : prov.
|
||||||
Lemma prov_par n (u : Tm n) a b : prov u a -> hfb u -> Par.R a b -> prov u b.
|
Lemma prov_par n (u : Tm n) a b : prov u a -> hfb u -> Par.R a b -> prov u b.
|
||||||
Proof.
|
Proof.
|
||||||
move => + + h. move : u.
|
move => + + h. move : u.
|
||||||
elim : n a b /h.
|
elim : n a b /h => //=.
|
||||||
- move => n a0 a1 b0 b1 ha iha hb ihb u /=.
|
- move => n a0 a1 b0 b1 ha iha hb ihb u /= h h0.
|
||||||
simp prov => h h0.
|
|
||||||
have h1 : hfb (ren_Tm shift u) by eauto using ren_hfb.
|
have h1 : hfb (ren_Tm shift u) by eauto using ren_hfb.
|
||||||
move /iha /(_ h1) : h.
|
move /iha /(_ h1) : h.
|
||||||
move /(prov_morph _ _ (scons b1 VarTm)) /(_ h1).
|
move /(prov_morph _ _ (scons b1 VarTm)) /(_ h1).
|
||||||
|
@ -1192,21 +1165,16 @@ Proof.
|
||||||
- hauto lq:on rew:db:prov.
|
- hauto lq:on rew:db:prov.
|
||||||
- hauto lq:on rew:db:prov.
|
- hauto lq:on rew:db:prov.
|
||||||
- hauto lq:on rew:db:prov.
|
- hauto lq:on rew:db:prov.
|
||||||
- move => n a0 a1 ha iha A B. simp prov. move /iha.
|
- move => n a0 a1 ha iha A B. move /iha.
|
||||||
hauto l:on use:prov_ren.
|
hauto l:on use:prov_ren.
|
||||||
- hauto l:on rew:db:prov.
|
- hauto l:on rew:db:prov.
|
||||||
- simp prov.
|
|
||||||
- hauto lq:on rew:db:prov.
|
- hauto lq:on rew:db:prov.
|
||||||
- hauto l:on rew:db:prov.
|
- hauto l:on rew:db:prov.
|
||||||
- hauto l:on rew:db:prov.
|
- move => n p A0 A1 B0 B1 hA ihA hB ihB u.
|
||||||
- hauto lq:on rew:db:prov.
|
|
||||||
- move => n p A0 A1 B0 B1 hA ihA hB ihB u. simp prov.
|
|
||||||
case : u => //=.
|
case : u => //=.
|
||||||
move => p0 A B [? [h2 h3]]. subst.
|
move => p0 A B [? [h2 h3]]. subst.
|
||||||
move => ?. repeat split => //=;
|
move => ?. repeat split => //=;
|
||||||
hauto l:on use:rtc_r rew:db:prov.
|
hauto l:on use:rtc_r rew:db:prov.
|
||||||
- sfirstorder.
|
|
||||||
- sfirstorder.
|
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Lemma prov_pars n (u : Tm n) a b : hfb u -> prov u a -> rtc Par.R a b -> prov u b.
|
Lemma prov_pars n (u : Tm n) a b : hfb u -> prov u a -> rtc Par.R a b -> prov u b.
|
||||||
|
@ -1227,7 +1195,7 @@ Proof.
|
||||||
move : u. elim : n / a => //=.
|
move : u. elim : n / a => //=.
|
||||||
- move => n a ih [] //=.
|
- move => n a ih [] //=.
|
||||||
+ move => p A B /=.
|
+ move => p A B /=.
|
||||||
simp prov. move /ih {ih}.
|
move /ih {ih}.
|
||||||
simpl.
|
simpl.
|
||||||
move => [A0[B0[h [h0 h1]]]].
|
move => [A0[B0[h [h0 h1]]]].
|
||||||
have : exists A1, rtc Par.R A A1 /\ ren_Tm shift A1 = A0
|
have : exists A1, rtc Par.R A A1 /\ ren_Tm shift A1 = A0
|
||||||
|
@ -1240,14 +1208,11 @@ Proof.
|
||||||
have {}h0 : subst_Tm (scons Bot VarTm) (extract a) =
|
have {}h0 : subst_Tm (scons Bot VarTm) (extract a) =
|
||||||
subst_Tm (scons Bot VarTm) (ren_Tm shift (TBind p A1 B1)) by sauto lq:on.
|
subst_Tm (scons Bot VarTm) (ren_Tm shift (TBind p A1 B1)) by sauto lq:on.
|
||||||
move : h0. asimpl.
|
move : h0. asimpl.
|
||||||
hauto lq:on rew:db:extract.
|
hauto lq:on.
|
||||||
+ hauto q:on rew:db:extract, prov.
|
+ hauto q:on.
|
||||||
- hauto lq:on rew:off inv:Tm rew:db:prov, extract.
|
- hauto lq:on rew:off inv:Tm rew:db:prov.
|
||||||
- move => + + + + + []//=;
|
- hauto inv:Tm l:on rew:db:prov.
|
||||||
hauto lq:on rew:off rew:db:prov, extract.
|
- hauto l:on inv:Tm rew:db:prov.
|
||||||
- hauto inv:Tm l:on rew:db:prov, extract.
|
|
||||||
- hauto l:on inv:Tm rew:db:prov, extract.
|
|
||||||
- hauto l:on inv:Tm rew:db:prov, extract.
|
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Lemma EPar_Par n (a b : Tm n) : EPar.R a b -> Par.R a b.
|
Lemma EPar_Par n (a b : Tm n) : EPar.R a b -> Par.R a b.
|
||||||
|
|
Loading…
Add table
Reference in a new issue