]> matita.cs.unibo.it Git - helm.git/blob - matita/matita/contribs/lambdadelta/basic_2/relocation/fqu_fqu.ma
- lambdadelta: first commutation property on lazy equivalence for
[helm.git] / matita / matita / contribs / lambdadelta / basic_2 / relocation / fqu_fqu.ma
1 (**************************************************************************)
2 (*       ___                                                              *)
3 (*      ||M||                                                             *)
4 (*      ||A||       A project by Andrea Asperti                           *)
5 (*      ||T||                                                             *)
6 (*      ||I||       Developers:                                           *)
7 (*      ||T||         The HELM team.                                      *)
8 (*      ||A||         http://helm.cs.unibo.it                             *)
9 (*      \   /                                                             *)
10 (*       \ /        This file is distributed under the terms of the       *)
11 (*        v         GNU General Public License Version 2                  *)
12 (*                                                                        *)
13 (**************************************************************************)
14
15 include "basic_2/relocation/lleq_lleq.ma".
16 include "basic_2/relocation/fqu.ma".
17
18 (* SUPCLOSURE ***************************************************************)
19
20 (* Advanced properties ******************************************************)
21
22 lemma lleq_fqu_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊃ ⦃G2, K2, U⦄ →
23                       ∀L1. L1 ⋕[T] L2 →
24                       ∃∃K1. ⦃G1, L1, T⦄ ⊃ ⦃G2, K1, U⦄ & K1 ⋕[U] K2.
25 #G1 #G2 #L2 #K2 #T #U #H elim H -G1 -G2 -L2 -K2 -T -U
26 [ #I #G #L2 #V #L1 #H elim (lleq_inv_lref_dx … H I L2 V) -H //
27   #K1 #H1 #H2 lapply (ldrop_inv_O2 … H1) -H1
28   #H destruct /2 width=3 by fqu_lref_O, ex2_intro/
29 | * [ #a ] #I #G #L2 #V #T #L1 #H
30   [ elim (lleq_inv_bind … H)
31   | elim (lleq_inv_flat … H)
32   ] -H
33   /2 width=3 by fqu_pair_sn, ex2_intro/
34 | #a #I #G #L2 #V #T #L1 #H elim (lleq_inv_bind … H) -H
35   /2 width=3 by fqu_bind_dx, ex2_intro/
36 | #I #G #L2 #V #T #L1 #H elim (lleq_inv_flat … H) -H
37   /2 width=3 by fqu_flat_dx, ex2_intro/
38 | #G #L2 #K2 #T #U #e #HLK2 #HTU #L1 #HL12
39   elim (ldrop_O1_le (e+1) L1)
40   [ /3 width=11 by fqu_drop, lleq_inv_lift, ex2_intro/
41   | lapply (ldrop_fwd_length_le2 … HLK2) -K2
42     lapply (lleq_fwd_length … HL12) -T -U //
43   ]
44 ]
45 qed-.