|
1 theory Term5 |
|
2 imports "Nominal2_Atoms" "Nominal2_Eqvt" "Nominal2_Supp" "Abs" "Perm" "Fv" "Rsp" "../Attic/Prove" |
|
3 begin |
|
4 |
|
5 atom_decl name |
|
6 |
|
7 datatype rtrm5 = |
|
8 rVr5 "name" |
|
9 | rAp5 "rtrm5" "rtrm5" |
|
10 | rLt5 "rlts" "rtrm5" --"bind (bv5 lts) in (rtrm5)" |
|
11 and rlts = |
|
12 rLnil |
|
13 | rLcons "name" "rtrm5" "rlts" |
|
14 |
|
15 primrec |
|
16 rbv5 |
|
17 where |
|
18 "rbv5 rLnil = {}" |
|
19 | "rbv5 (rLcons n t ltl) = {atom n} \<union> (rbv5 ltl)" |
|
20 |
|
21 |
|
22 setup {* snd o define_raw_perms (Datatype.the_info @{theory} "Term5.rtrm5") 2 *} |
|
23 print_theorems |
|
24 |
|
25 local_setup {* snd o define_fv_alpha (Datatype.the_info @{theory} "Term5.rtrm5") |
|
26 [[[], [], [(SOME (@{term rbv5}, false), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [0, 2]])] *} |
|
27 print_theorems |
|
28 |
|
29 notation |
|
30 alpha_rtrm5 ("_ \<approx>5 _" [100, 100] 100) and |
|
31 alpha_rlts ("_ \<approx>l _" [100, 100] 100) |
|
32 thm alpha_rtrm5_alpha_rlts_alpha_rbv5.intros |
|
33 |
|
34 local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_alpha_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *} |
|
35 thm alpha5_inj |
|
36 |
|
37 lemma rbv5_eqvt[eqvt]: |
|
38 "pi \<bullet> (rbv5 x) = rbv5 (pi \<bullet> x)" |
|
39 apply (induct x) |
|
40 apply (simp_all add: eqvts atom_eqvt) |
|
41 done |
|
42 |
|
43 lemma fv_rtrm5_rlts_eqvt[eqvt]: |
|
44 "pi \<bullet> (fv_rtrm5 x) = fv_rtrm5 (pi \<bullet> x)" |
|
45 "pi \<bullet> (fv_rlts l) = fv_rlts (pi \<bullet> l)" |
|
46 "pi \<bullet> (fv_rbv5 l) = fv_rbv5 (pi \<bullet> l)" |
|
47 apply (induct x and l) |
|
48 apply (simp_all add: eqvts atom_eqvt) |
|
49 done |
|
50 |
|
51 local_setup {* |
|
52 (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_eqvt}, []), |
|
53 build_alpha_eqvts [@{term alpha_rtrm5}, @{term alpha_rlts}, @{term alpha_rbv5}] (fn _ => alpha_eqvt_tac @{thm alpha_rtrm5_alpha_rlts_alpha_rbv5.induct} @{thms alpha5_inj permute_rtrm5_permute_rlts.simps} ctxt 1) ctxt) ctxt)) *} |
|
54 print_theorems |
|
55 |
|
56 lemma alpha5_reflp: |
|
57 "y \<approx>5 y \<and> (x \<approx>l x \<and> alpha_rbv5 x x)" |
|
58 apply (rule rtrm5_rlts.induct) |
|
59 apply (simp_all add: alpha5_inj) |
|
60 apply (rule_tac x="0::perm" in exI) |
|
61 apply (simp add: eqvts alpha_gen fresh_star_def fresh_zero_perm) |
|
62 done |
|
63 |
|
64 lemma alpha5_symp: |
|
65 "(a \<approx>5 b \<longrightarrow> b \<approx>5 a) \<and> |
|
66 (x \<approx>l y \<longrightarrow> y \<approx>l x) \<and> |
|
67 (alpha_rbv5 x y \<longrightarrow> alpha_rbv5 y x)" |
|
68 sorry |
|
69 |
|
70 lemma alpha5_transp: |
|
71 "(a \<approx>5 b \<longrightarrow> (\<forall>c. b \<approx>5 c \<longrightarrow> a \<approx>5 c)) \<and> |
|
72 (x \<approx>l y \<longrightarrow> (\<forall>z. y \<approx>l z \<longrightarrow> x \<approx>l z)) \<and> |
|
73 (alpha_rbv5 k l \<longrightarrow> (\<forall>m. alpha_rbv5 l m \<longrightarrow> alpha_rbv5 k m))" |
|
74 sorry |
|
75 |
|
76 lemma alpha5_equivp: |
|
77 "equivp alpha_rtrm5" |
|
78 "equivp alpha_rlts" |
|
79 unfolding equivp_reflp_symp_transp reflp_def symp_def transp_def |
|
80 apply (simp_all only: alpha5_reflp) |
|
81 apply (meson alpha5_symp alpha5_transp) |
|
82 apply (meson alpha5_symp alpha5_transp) |
|
83 done |
|
84 |
|
85 quotient_type |
|
86 trm5 = rtrm5 / alpha_rtrm5 |
|
87 and |
|
88 lts = rlts / alpha_rlts |
|
89 by (auto intro: alpha5_equivp) |
|
90 |
|
91 local_setup {* |
|
92 (fn ctxt => ctxt |
|
93 |> snd o (Quotient_Def.quotient_lift_const ("Vr5", @{term rVr5})) |
|
94 |> snd o (Quotient_Def.quotient_lift_const ("Ap5", @{term rAp5})) |
|
95 |> snd o (Quotient_Def.quotient_lift_const ("Lt5", @{term rLt5})) |
|
96 |> snd o (Quotient_Def.quotient_lift_const ("Lnil", @{term rLnil})) |
|
97 |> snd o (Quotient_Def.quotient_lift_const ("Lcons", @{term rLcons})) |
|
98 |> snd o (Quotient_Def.quotient_lift_const ("fv_trm5", @{term fv_rtrm5})) |
|
99 |> snd o (Quotient_Def.quotient_lift_const ("fv_lts", @{term fv_rlts})) |
|
100 |> snd o (Quotient_Def.quotient_lift_const ("fv_bv5", @{term fv_rbv5})) |
|
101 |> snd o (Quotient_Def.quotient_lift_const ("bv5", @{term rbv5})) |
|
102 |> snd o (Quotient_Def.quotient_lift_const ("alpha_bv5", @{term alpha_rbv5}))) |
|
103 *} |
|
104 print_theorems |
|
105 |
|
106 lemma alpha5_rfv: |
|
107 "(t \<approx>5 s \<Longrightarrow> fv_rtrm5 t = fv_rtrm5 s)" |
|
108 "(l \<approx>l m \<Longrightarrow> (fv_rlts l = fv_rlts m \<and> fv_rbv5 l = fv_rbv5 m))" |
|
109 "(alpha_rbv5 b c \<Longrightarrow> fv_rbv5 b = fv_rbv5 c)" |
|
110 apply(induct rule: alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts) |
|
111 apply(simp_all) |
|
112 apply(simp add: alpha_gen) |
|
113 done |
|
114 |
|
115 lemma bv_list_rsp: |
|
116 shows "x \<approx>l y \<Longrightarrow> rbv5 x = rbv5 y" |
|
117 apply(induct rule: alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts(2)) |
|
118 apply(simp_all) |
|
119 apply(clarify) |
|
120 apply simp |
|
121 done |
|
122 |
|
123 local_setup {* snd o Local_Theory.note ((@{binding alpha_dis}, []), (flat (map (distinct_rel @{context} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases}) [(@{thms rtrm5.distinct}, @{term alpha_rtrm5}), (@{thms rlts.distinct}, @{term alpha_rlts}), (@{thms rlts.distinct}, @{term alpha_rbv5})]))) *} |
|
124 print_theorems |
|
125 |
|
126 local_setup {* snd o Local_Theory.note ((@{binding alpha_bn_rsp}, []), prove_alpha_bn_rsp [@{term alpha_rtrm5}, @{term alpha_rlts}] @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts} @{thms alpha5_inj alpha_dis} @{thms alpha5_equivp} @{context} (@{term alpha_rbv5}, 1)) *} |
|
127 thm alpha_bn_rsp |
|
128 |
|
129 |
|
130 lemma [quot_respect]: |
|
131 "(alpha_rlts ===> op =) fv_rlts fv_rlts" |
|
132 "(alpha_rlts ===> op =) fv_rbv5 fv_rbv5" |
|
133 "(alpha_rtrm5 ===> op =) fv_rtrm5 fv_rtrm5" |
|
134 "(alpha_rlts ===> op =) rbv5 rbv5" |
|
135 "(op = ===> alpha_rtrm5) rVr5 rVr5" |
|
136 "(alpha_rtrm5 ===> alpha_rtrm5 ===> alpha_rtrm5) rAp5 rAp5" |
|
137 "(alpha_rlts ===> alpha_rtrm5 ===> alpha_rtrm5) rLt5 rLt5" |
|
138 "(op = ===> alpha_rtrm5 ===> alpha_rlts ===> alpha_rlts) rLcons rLcons" |
|
139 "(op = ===> alpha_rtrm5 ===> alpha_rtrm5) permute permute" |
|
140 "(op = ===> alpha_rlts ===> alpha_rlts) permute permute" |
|
141 "(alpha_rlts ===> alpha_rlts ===> op =) alpha_rbv5 alpha_rbv5" |
|
142 apply (simp_all add: alpha5_inj alpha5_rfv alpha5_eqvt bv_list_rsp alpha5_reflp alpha_bn_rsp) |
|
143 apply (clarify) |
|
144 apply (rule_tac x="0" in exI) apply (simp add: fresh_star_def fresh_zero_perm alpha_gen alpha5_rfv) |
|
145 done |
|
146 |
|
147 lemma |
|
148 shows "(alpha_rlts ===> op =) rbv5 rbv5" |
|
149 by (simp add: bv_list_rsp) |
|
150 |
|
151 lemmas trm5_lts_inducts = rtrm5_rlts.inducts[quot_lifted] |
|
152 |
|
153 instantiation trm5 and lts :: pt |
|
154 begin |
|
155 |
|
156 quotient_definition |
|
157 "permute_trm5 :: perm \<Rightarrow> trm5 \<Rightarrow> trm5" |
|
158 is |
|
159 "permute :: perm \<Rightarrow> rtrm5 \<Rightarrow> rtrm5" |
|
160 |
|
161 quotient_definition |
|
162 "permute_lts :: perm \<Rightarrow> lts \<Rightarrow> lts" |
|
163 is |
|
164 "permute :: perm \<Rightarrow> rlts \<Rightarrow> rlts" |
|
165 |
|
166 instance by default |
|
167 (simp_all add: permute_rtrm5_permute_rlts_zero[quot_lifted] permute_rtrm5_permute_rlts_append[quot_lifted]) |
|
168 |
|
169 end |
|
170 |
|
171 lemmas permute_trm5_lts = permute_rtrm5_permute_rlts.simps[quot_lifted] |
|
172 lemmas bv5[simp] = rbv5.simps[quot_lifted] |
|
173 lemmas fv_trm5_bv5[simp] = fv_rtrm5_fv_rbv5.simps[quot_lifted] |
|
174 lemmas fv_lts[simp] = fv_rlts.simps[quot_lifted] |
|
175 lemmas alpha5_INJ = alpha5_inj[unfolded alpha_gen, quot_lifted, folded alpha_gen] |
|
176 |
|
177 lemma lets_bla: |
|
178 "x \<noteq> z \<Longrightarrow> y \<noteq> z \<Longrightarrow> x \<noteq> y \<Longrightarrow>(Lt5 (Lcons x (Vr5 y) Lnil) (Vr5 x)) \<noteq> (Lt5 (Lcons x (Vr5 z) Lnil) (Vr5 x))" |
|
179 apply (simp only: alpha5_INJ) |
|
180 apply (simp only: bv5) |
|
181 apply simp |
|
182 done |
|
183 |
|
184 lemma lets_ok: |
|
185 "(Lt5 (Lcons x (Vr5 y) Lnil) (Vr5 x)) = (Lt5 (Lcons y (Vr5 y) Lnil) (Vr5 y))" |
|
186 apply (simp add: alpha5_INJ) |
|
187 apply (rule_tac x="(x \<leftrightarrow> y)" in exI) |
|
188 apply (simp_all add: alpha_gen) |
|
189 apply (simp add: permute_trm5_lts fresh_star_def eqvts) |
|
190 done |
|
191 |
|
192 lemma lets_ok3: |
|
193 "x \<noteq> y \<Longrightarrow> |
|
194 (Lt5 (Lcons x (Ap5 (Vr5 y) (Vr5 x)) (Lcons y (Vr5 y) Lnil)) (Ap5 (Vr5 x) (Vr5 y))) \<noteq> |
|
195 (Lt5 (Lcons y (Ap5 (Vr5 x) (Vr5 y)) (Lcons x (Vr5 x) Lnil)) (Ap5 (Vr5 x) (Vr5 y)))" |
|
196 apply (simp add: permute_trm5_lts alpha_gen alpha5_INJ) |
|
197 done |
|
198 |
|
199 |
|
200 lemma lets_not_ok1: |
|
201 "(Lt5 (Lcons x (Vr5 x) (Lcons y (Vr5 y) Lnil)) (Ap5 (Vr5 x) (Vr5 y))) = |
|
202 (Lt5 (Lcons y (Vr5 x) (Lcons x (Vr5 y) Lnil)) (Ap5 (Vr5 x) (Vr5 y)))" |
|
203 apply (simp add: alpha5_INJ alpha_gen) |
|
204 apply (rule_tac x="0::perm" in exI) |
|
205 apply (simp add: permute_trm5_lts fresh_star_def alpha5_INJ(5) alpha5_INJ(2) alpha5_INJ(1) eqvts) |
|
206 apply blast |
|
207 done |
|
208 |
|
209 lemma distinct_helper: |
|
210 shows "\<not>(rVr5 x \<approx>5 rAp5 y z)" |
|
211 apply auto |
|
212 apply (erule alpha_rtrm5.cases) |
|
213 apply (simp_all only: rtrm5.distinct) |
|
214 done |
|
215 |
|
216 lemma distinct_helper2: |
|
217 shows "(Vr5 x) \<noteq> (Ap5 y z)" |
|
218 by (lifting distinct_helper) |
|
219 |
|
220 lemma lets_nok: |
|
221 "x \<noteq> y \<Longrightarrow> x \<noteq> z \<Longrightarrow> z \<noteq> y \<Longrightarrow> |
|
222 (Lt5 (Lcons x (Ap5 (Vr5 z) (Vr5 z)) (Lcons y (Vr5 z) Lnil)) (Ap5 (Vr5 x) (Vr5 y))) \<noteq> |
|
223 (Lt5 (Lcons y (Vr5 z) (Lcons x (Ap5 (Vr5 z) (Vr5 z)) Lnil)) (Ap5 (Vr5 x) (Vr5 y)))" |
|
224 apply (simp only: alpha5_INJ(3) alpha5_INJ(5) alpha_gen permute_trm5_lts fresh_star_def) |
|
225 apply (simp add: distinct_helper2 alpha5_INJ permute_trm5_lts) |
|
226 done |
|
227 |
|
228 end |