Recover the contra lemmas

This commit is contained in:
Yiyun Liu 2025-01-20 16:28:44 -05:00
parent d68df5d0bc
commit 9c9ce52b63
5 changed files with 110 additions and 28 deletions

View file

@ -1,5 +1,4 @@
Require Import Autosubst2.core Autosubst2.fintype Autosubst2.syntax.
Require Import fp_red.
Require Import Autosubst2.core Autosubst2.fintype Autosubst2.syntax fp_red compile.
From Hammer Require Import Tactics.
From Equations Require Import Equations.
Require Import ssreflect ssrbool.
@ -295,9 +294,9 @@ Proof.
- hauto lq:on ctrs:prov.
- hauto lq:on rew:off ctrs:prov b:on.
- hauto lq:on ctrs:prov.
- move => n.
- move => n k.
have : @prov n Bot Bot by auto using P_Bot.
tauto.
eauto.
Qed.
Lemma ne_pars_inv n (a b : Tm n) :
@ -311,23 +310,37 @@ Lemma ne_pars_extract n (a b : Tm n) :
ne a -> rtc Par.R a b -> (exists i, extract b = (VarTm i)) \/ extract b = Bot.
Proof. hauto lq:on rew:off use:ne_pars_inv, prov_extract. Qed.
Lemma const_pars_extract n k b :
rtc Par.R (Const k : Tm n) b -> extract b = Const k.
Proof. hauto l:on use:pars_const_inv, prov_extract. Qed.
Lemma compile_ne n (a : Tm n) :
ne a = ne (Compile.F a) /\ nf a = nf (Compile.F a).
Proof.
elim : n / a => //=; sfirstorder b:on.
Qed.
Lemma join_bind_ne_contra n p (A : Tm n) B C :
ne C ->
join (TBind p A B) C -> False.
Join.R (TBind p A B) C -> False.
Proof.
move => hC [D [h0 h1]].
move /pars_pi_inv : h0 => [A0 [B0 [h2 [h3 h4]]]].
rewrite /Join.R. move => hC /=.
rewrite !pair_eq.
move => [[[D [h0 h1]] _] _].
have {}hC : ne (Compile.F C) by hauto lq:on use:compile_ne.
have {}hC : ne (Proj PL (Proj PL (Compile.F C))) by scongruence.
have : (exists i, extract D = (VarTm i)) \/ extract D = Bot by eauto using ne_pars_extract.
have : extract D = Const p by eauto using const_pars_extract.
sfirstorder.
Qed.
Lemma join_univ_ne_contra n i C :
ne C ->
join (Univ i : Tm n) C -> False.
Join.R (Univ i : Tm n) C -> False.
Proof.
move => hC [D [h0 h1]].
move /pars_univ_inv : h0 => ?.
have : (exists i, extract D = (VarTm i)) \/ extract D = Bot by eauto using ne_pars_extract.
have : (exists i, extract D = (VarTm i)) \/ exists k, extract D =(Const k) by hauto q:on use:ne_pars_extract, compile_ne.
sfirstorder.
Qed.
@ -336,7 +349,7 @@ Qed.
Lemma InterpExt_Join n i I (A B : Tm n) PA PB :
A i ;; I PA ->
B i ;; I PB ->
join A B ->
Join.R A B ->
PA = PB.
Proof.
move => h. move : B PB. elim : A PA /h.