16 freeExp = VAR nat |
16 freeExp = VAR nat |
17 | PLUS freeExp freeExp |
17 | PLUS freeExp freeExp |
18 | FNCALL nat "freeExp list" |
18 | FNCALL nat "freeExp list" |
19 |
19 |
20 text{*The equivalence relation, which makes PLUS associative.*} |
20 text{*The equivalence relation, which makes PLUS associative.*} |
21 consts exprel :: "(freeExp * freeExp) set" |
|
22 |
|
23 abbreviation |
|
24 exp_rel :: "[freeExp, freeExp] => bool" (infixl "~~" 50) where |
|
25 "X ~~ Y == (X,Y) \<in> exprel" |
|
26 |
|
27 notation (xsymbols) |
|
28 exp_rel (infixl "\<sim>" 50) |
|
29 notation (HTML output) |
|
30 exp_rel (infixl "\<sim>" 50) |
|
31 |
21 |
32 text{*The first rule is the desired equation. The next three rules |
22 text{*The first rule is the desired equation. The next three rules |
33 make the equations applicable to subterms. The last two rules are symmetry |
23 make the equations applicable to subterms. The last two rules are symmetry |
34 and transitivity.*} |
24 and transitivity.*} |
35 inductive "exprel" |
25 inductive_set |
36 intros |
26 exprel :: "(freeExp * freeExp) set" |
37 ASSOC: "PLUS X (PLUS Y Z) \<sim> PLUS (PLUS X Y) Z" |
27 and exp_rel :: "[freeExp, freeExp] => bool" (infixl "\<sim>" 50) |
38 VAR: "VAR N \<sim> VAR N" |
28 where |
39 PLUS: "\<lbrakk>X \<sim> X'; Y \<sim> Y'\<rbrakk> \<Longrightarrow> PLUS X Y \<sim> PLUS X' Y'" |
29 "X \<sim> Y == (X,Y) \<in> exprel" |
40 FNCALL: "(Xs,Xs') \<in> listrel exprel \<Longrightarrow> FNCALL F Xs \<sim> FNCALL F Xs'" |
30 | ASSOC: "PLUS X (PLUS Y Z) \<sim> PLUS (PLUS X Y) Z" |
41 SYM: "X \<sim> Y \<Longrightarrow> Y \<sim> X" |
31 | VAR: "VAR N \<sim> VAR N" |
42 TRANS: "\<lbrakk>X \<sim> Y; Y \<sim> Z\<rbrakk> \<Longrightarrow> X \<sim> Z" |
32 | PLUS: "\<lbrakk>X \<sim> X'; Y \<sim> Y'\<rbrakk> \<Longrightarrow> PLUS X Y \<sim> PLUS X' Y'" |
|
33 | FNCALL: "(Xs,Xs') \<in> listrel exprel \<Longrightarrow> FNCALL F Xs \<sim> FNCALL F Xs'" |
|
34 | SYM: "X \<sim> Y \<Longrightarrow> Y \<sim> X" |
|
35 | TRANS: "\<lbrakk>X \<sim> Y; Y \<sim> Z\<rbrakk> \<Longrightarrow> X \<sim> Z" |
43 monos listrel_mono |
36 monos listrel_mono |
44 |
37 |
45 |
38 |
46 text{*Proving that it is an equivalence relation*} |
39 text{*Proving that it is an equivalence relation*} |
47 |
40 |
48 lemma exprel_refl: "X \<sim> X" |
41 lemma exprel_refl: "X \<sim> X" |
49 and list_exprel_refl: "(Xs,Xs) \<in> listrel(exprel)" |
42 and list_exprel_refl: "(Xs,Xs) \<in> listrel(exprel)" |
50 by (induct X and Xs) (blast intro: exprel.intros listrel_intros)+ |
43 by (induct X and Xs) (blast intro: exprel.intros listrel.intros)+ |
51 |
44 |
52 theorem equiv_exprel: "equiv UNIV exprel" |
45 theorem equiv_exprel: "equiv UNIV exprel" |
53 proof - |
46 proof - |
54 have "reflexive exprel" by (simp add: refl_def exprel_refl) |
47 have "reflexive exprel" by (simp add: refl_def exprel_refl) |
55 moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM) |
48 moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM) |
61 using equiv_listrel [OF equiv_exprel] by simp |
54 using equiv_listrel [OF equiv_exprel] by simp |
62 |
55 |
63 |
56 |
64 lemma FNCALL_Nil: "FNCALL F [] \<sim> FNCALL F []" |
57 lemma FNCALL_Nil: "FNCALL F [] \<sim> FNCALL F []" |
65 apply (rule exprel.intros) |
58 apply (rule exprel.intros) |
66 apply (rule listrel_intros) |
59 apply (rule listrel.intros) |
67 done |
60 done |
68 |
61 |
69 lemma FNCALL_Cons: |
62 lemma FNCALL_Cons: |
70 "\<lbrakk>X \<sim> X'; (Xs,Xs') \<in> listrel(exprel)\<rbrakk> |
63 "\<lbrakk>X \<sim> X'; (Xs,Xs') \<in> listrel(exprel)\<rbrakk> |
71 \<Longrightarrow> FNCALL F (X#Xs) \<sim> FNCALL F (X'#Xs')" |
64 \<Longrightarrow> FNCALL F (X#Xs) \<sim> FNCALL F (X'#Xs')" |
72 by (blast intro: exprel.intros listrel_intros) |
65 by (blast intro: exprel.intros listrel.intros) |
73 |
66 |
74 |
67 |
75 |
68 |
76 subsection{*Some Functions on the Free Algebra*} |
69 subsection{*Some Functions on the Free Algebra*} |
77 |
70 |
96 text{*This theorem lets us prove that the vars function respects the |
89 text{*This theorem lets us prove that the vars function respects the |
97 equivalence relation. It also helps us prove that Variable |
90 equivalence relation. It also helps us prove that Variable |
98 (the abstract constructor) is injective*} |
91 (the abstract constructor) is injective*} |
99 theorem exprel_imp_eq_freevars: "U \<sim> V \<Longrightarrow> freevars U = freevars V" |
92 theorem exprel_imp_eq_freevars: "U \<sim> V \<Longrightarrow> freevars U = freevars V" |
100 apply (induct set: exprel) |
93 apply (induct set: exprel) |
101 apply (erule_tac [4] listrel_induct) |
94 apply (erule_tac [4] listrel.induct) |
102 apply (simp_all add: Un_assoc) |
95 apply (simp_all add: Un_assoc) |
103 done |
96 done |
104 |
97 |
105 |
98 |
106 |
99 |
127 "freefun (PLUS X Y) = 0" |
120 "freefun (PLUS X Y) = 0" |
128 "freefun (FNCALL F Xs) = F" |
121 "freefun (FNCALL F Xs) = F" |
129 |
122 |
130 theorem exprel_imp_eq_freefun: |
123 theorem exprel_imp_eq_freefun: |
131 "U \<sim> V \<Longrightarrow> freefun U = freefun V" |
124 "U \<sim> V \<Longrightarrow> freefun U = freefun V" |
132 by (induct set: exprel) (simp_all add: listrel_intros) |
125 by (induct set: exprel) (simp_all add: listrel.intros) |
133 |
126 |
134 |
127 |
135 text{*This function, which returns the list of function arguments, is used to |
128 text{*This function, which returns the list of function arguments, is used to |
136 prove part of the injectivity property for FnCall.*} |
129 prove part of the injectivity property for FnCall.*} |
137 consts freeargs :: "freeExp \<Rightarrow> freeExp list" |
130 consts freeargs :: "freeExp \<Rightarrow> freeExp list" |
141 "freeargs (FNCALL F Xs) = Xs" |
134 "freeargs (FNCALL F Xs) = Xs" |
142 |
135 |
143 theorem exprel_imp_eqv_freeargs: |
136 theorem exprel_imp_eqv_freeargs: |
144 "U \<sim> V \<Longrightarrow> (freeargs U, freeargs V) \<in> listrel exprel" |
137 "U \<sim> V \<Longrightarrow> (freeargs U, freeargs V) \<in> listrel exprel" |
145 apply (induct set: exprel) |
138 apply (induct set: exprel) |
146 apply (erule_tac [4] listrel_induct) |
139 apply (erule_tac [4] listrel.induct) |
147 apply (simp_all add: listrel_intros) |
140 apply (simp_all add: listrel.intros) |
148 apply (blast intro: symD [OF equiv.sym [OF equiv_list_exprel]]) |
141 apply (blast intro: symD [OF equiv.sym [OF equiv_list_exprel]]) |
149 apply (blast intro: transD [OF equiv.trans [OF equiv_list_exprel]]) |
142 apply (blast intro: transD [OF equiv.trans [OF equiv_list_exprel]]) |
150 done |
143 done |
151 |
144 |
152 |
145 |