5261
|
1 |
(* Title: HOL/Lambda/ListBeta.thy
|
|
2 |
ID: $Id$
|
|
3 |
Author: Tobias Nipkow
|
|
4 |
Copyright 1998 TU Muenchen
|
|
5 |
|
|
6 |
Lifting beta-reduction to lists of terms, reducing exactly one element
|
|
7 |
*)
|
|
8 |
|
9762
|
9 |
theory ListBeta = ListApplication + ListOrder:
|
|
10 |
|
|
11 |
syntax
|
|
12 |
"_list_beta" :: "dB => dB => bool" (infixl "=>" 50)
|
|
13 |
translations
|
|
14 |
"rs => ss" == "(rs,ss) : step1 beta"
|
|
15 |
|
|
16 |
lemma head_Var_reduction_aux:
|
|
17 |
"v -> v' ==> \<forall>rs. v = Var n $$ rs --> (\<exists>ss. rs => ss \<and> v' = Var n $$ ss)"
|
|
18 |
apply (erule beta.induct)
|
|
19 |
apply simp
|
|
20 |
apply (rule allI)
|
|
21 |
apply (rule_tac xs = rs in rev_exhaust)
|
|
22 |
apply simp
|
|
23 |
apply (force intro: append_step1I)
|
|
24 |
apply (rule allI)
|
|
25 |
apply (rule_tac xs = rs in rev_exhaust)
|
|
26 |
apply simp
|
|
27 |
apply (tactic {* mk_auto_tac (claset() addIs [disjI2 RS append_step1I], simpset()) 0 3 *})
|
|
28 |
-- FIXME
|
|
29 |
done
|
|
30 |
|
|
31 |
|
|
32 |
lemma head_Var_reduction:
|
|
33 |
"Var n $$ rs -> v ==> (\<exists>ss. rs => ss \<and> v = Var n $$ ss)"
|
|
34 |
apply (drule head_Var_reduction_aux)
|
|
35 |
apply blast
|
|
36 |
done
|
5261
|
37 |
|
9762
|
38 |
lemma apps_betasE_aux:
|
|
39 |
"u -> u' ==> \<forall>r rs. u = r $$ rs -->
|
|
40 |
((\<exists>r'. r -> r' \<and> u' = r'$$rs) \<or>
|
|
41 |
(\<exists>rs'. rs => rs' \<and> u' = r$$rs') \<or>
|
|
42 |
(\<exists>s t ts. r = Abs s \<and> rs = t#ts \<and> u' = s[t/0]$$ts))"
|
|
43 |
apply (erule beta.induct)
|
|
44 |
apply (clarify del: disjCI)
|
|
45 |
apply (case_tac r)
|
|
46 |
apply simp
|
|
47 |
apply (simp add: App_eq_foldl_conv)
|
|
48 |
apply (simp only: split: split_if_asm)
|
|
49 |
apply simp
|
|
50 |
apply blast
|
|
51 |
apply simp
|
|
52 |
apply (simp add: App_eq_foldl_conv)
|
|
53 |
apply (simp only: split: split_if_asm)
|
|
54 |
apply simp
|
|
55 |
apply simp
|
|
56 |
apply (clarify del: disjCI)
|
|
57 |
apply (drule App_eq_foldl_conv [THEN iffD1])
|
|
58 |
apply (simp only: split: split_if_asm)
|
|
59 |
apply simp
|
|
60 |
apply blast
|
|
61 |
apply (force intro: disjI1 [THEN append_step1I])
|
|
62 |
apply (clarify del: disjCI)
|
|
63 |
apply (drule App_eq_foldl_conv [THEN iffD1])
|
|
64 |
apply (simp only: split: split_if_asm)
|
|
65 |
apply simp
|
|
66 |
apply blast
|
|
67 |
apply (tactic {* mk_auto_tac (claset() addIs [disjI2 RS append_step1I],simpset()) 0 3 *})
|
|
68 |
-- FIXME
|
|
69 |
done
|
|
70 |
|
|
71 |
lemma apps_betasE [elim!]:
|
|
72 |
"[| r $$ rs -> s; !!r'. [| r -> r'; s = r' $$ rs |] ==> R;
|
|
73 |
!!rs'. [| rs => rs'; s = r $$ rs' |] ==> R;
|
|
74 |
!!t u us. [| r = Abs t; rs = u # us; s = t[u/0] $$ us |] ==> R |]
|
|
75 |
==> R"
|
|
76 |
proof -
|
|
77 |
assume major: "r $$ rs -> s"
|
|
78 |
case antecedent
|
|
79 |
show ?thesis
|
|
80 |
apply (cut_tac major [THEN apps_betasE_aux, THEN spec, THEN spec])
|
|
81 |
apply (assumption | rule refl | erule prems exE conjE impE disjE)+
|
|
82 |
done
|
|
83 |
qed
|
|
84 |
|
|
85 |
lemma apps_preserves_beta [simp]:
|
|
86 |
"r -> s ==> r $$ ss -> s $$ ss"
|
|
87 |
apply (induct_tac ss rule: rev_induct)
|
|
88 |
apply auto
|
|
89 |
done
|
|
90 |
|
|
91 |
lemma apps_preserves_beta2 [simp]:
|
|
92 |
"r ->> s ==> r $$ ss ->> s $$ ss"
|
|
93 |
apply (erule rtrancl_induct)
|
|
94 |
apply blast
|
|
95 |
apply (blast intro: apps_preserves_beta rtrancl_into_rtrancl)
|
|
96 |
done
|
|
97 |
|
|
98 |
lemma apps_preserves_betas [rulify, simp]:
|
|
99 |
"\<forall>ss. rs => ss --> r $$ rs -> r $$ ss"
|
|
100 |
apply (induct_tac rs rule: rev_induct)
|
|
101 |
apply simp
|
|
102 |
apply simp
|
|
103 |
apply clarify
|
|
104 |
apply (rule_tac xs = ss in rev_exhaust)
|
|
105 |
apply simp
|
|
106 |
apply simp
|
|
107 |
apply (drule Snoc_step1_SnocD)
|
|
108 |
apply blast
|
|
109 |
done
|
5261
|
110 |
|
|
111 |
end
|