| author | kuncar | 
| Sat, 15 Feb 2014 00:11:17 +0100 | |
| changeset 55487 | 6380313b8ed5 | 
| parent 44428 | ccb8998f70b7 | 
| child 56790 | f54097170704 | 
| permissions | -rw-r--r-- | 
| 44372 | 1  | 
(* Title: HOL/ex/Unification.thy  | 
2  | 
Author: Martin Coen, Cambridge University Computer Laboratory  | 
|
3  | 
Author: Konrad Slind, TUM & Cambridge University Computer Laboratory  | 
|
4  | 
Author: Alexander Krauss, TUM  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
5  | 
*)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
6  | 
|
| 44372 | 7  | 
header {* Substitution and Unification *}
 | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
8  | 
|
| 23219 | 9  | 
theory Unification  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
10  | 
imports Main  | 
| 23219 | 11  | 
begin  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
12  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
13  | 
text {* 
 | 
| 44428 | 14  | 
Implements Manna \& Waldinger's formalization, with Paulson's  | 
| 44372 | 15  | 
simplifications, and some new simplifications by Slind and Krauss.  | 
16  | 
||
| 44428 | 17  | 
Z Manna \& R Waldinger, Deductive Synthesis of the Unification  | 
| 44372 | 18  | 
Algorithm. SCP 1 (1981), 5-48  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
19  | 
|
| 44372 | 20  | 
L C Paulson, Verifying the Unification Algorithm in LCF. SCP 5  | 
21  | 
(1985), 143-170  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
22  | 
|
| 44372 | 23  | 
K Slind, Reasoning about Terminating Functional Programs,  | 
24  | 
Ph.D. thesis, TUM, 1999, Sect. 5.8  | 
|
25  | 
||
26  | 
A Krauss, Partial and Nested Recursive Function Definitions in  | 
|
27  | 
Higher-Order Logic, JAR 44(4):303–336, 2010. Sect. 6.3  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
28  | 
*}  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
29  | 
|
| 23219 | 30  | 
|
| 44368 | 31  | 
subsection {* Terms *}
 | 
32  | 
||
33  | 
text {* Binary trees with leaves that are constants or variables. *}
 | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
34  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
35  | 
datatype 'a trm =  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
36  | 
Var 'a  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
37  | 
| Const 'a  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
38  | 
| Comb "'a trm" "'a trm" (infix "\<cdot>" 60)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
39  | 
|
| 44368 | 40  | 
primrec vars_of :: "'a trm \<Rightarrow> 'a set"  | 
41  | 
where  | 
|
42  | 
  "vars_of (Var v) = {v}"
 | 
|
43  | 
| "vars_of (Const c) = {}"
 | 
|
44  | 
| "vars_of (M \<cdot> N) = vars_of M \<union> vars_of N"  | 
|
45  | 
||
46  | 
fun occs :: "'a trm \<Rightarrow> 'a trm \<Rightarrow> bool" (infixl "\<prec>" 54)  | 
|
47  | 
where  | 
|
| 44369 | 48  | 
"u \<prec> Var v \<longleftrightarrow> False"  | 
49  | 
| "u \<prec> Const c \<longleftrightarrow> False"  | 
|
50  | 
| "u \<prec> M \<cdot> N \<longleftrightarrow> u = M \<or> u = N \<or> u \<prec> M \<or> u \<prec> N"  | 
|
| 44368 | 51  | 
|
52  | 
||
53  | 
lemma finite_vars_of[intro]: "finite (vars_of t)"  | 
|
54  | 
by (induct t) simp_all  | 
|
55  | 
||
56  | 
lemma vars_iff_occseq: "x \<in> vars_of t \<longleftrightarrow> Var x \<prec> t \<or> Var x = t"  | 
|
57  | 
by (induct t) auto  | 
|
58  | 
||
59  | 
lemma occs_vars_subset: "M \<prec> N \<Longrightarrow> vars_of M \<subseteq> vars_of N"  | 
|
60  | 
by (induct N) auto  | 
|
61  | 
||
62  | 
||
63  | 
subsection {* Substitutions *}
 | 
|
64  | 
||
| 42463 | 65  | 
type_synonym 'a subst = "('a \<times> 'a trm) list"
 | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
66  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
67  | 
fun assoc :: "'a \<Rightarrow> 'b \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> 'b"
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
68  | 
where  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
69  | 
"assoc x d [] = d"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
70  | 
| "assoc x d ((p,q)#t) = (if x = p then q else assoc x d t)"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
71  | 
|
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
72  | 
primrec subst :: "'a trm \<Rightarrow> 'a subst \<Rightarrow> 'a trm" (infixl "\<lhd>" 55)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
73  | 
where  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
74  | 
"(Var v) \<lhd> s = assoc v (Var v) s"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
75  | 
| "(Const c) \<lhd> s = (Const c)"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
76  | 
| "(M \<cdot> N) \<lhd> s = (M \<lhd> s) \<cdot> (N \<lhd> s)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
77  | 
|
| 44368 | 78  | 
definition subst_eq (infixr "\<doteq>" 52)  | 
79  | 
where  | 
|
80  | 
"s1 \<doteq> s2 \<longleftrightarrow> (\<forall>t. t \<lhd> s1 = t \<lhd> s2)"  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
81  | 
|
| 44368 | 82  | 
fun comp :: "'a subst \<Rightarrow> 'a subst \<Rightarrow> 'a subst" (infixl "\<lozenge>" 56)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
83  | 
where  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
84  | 
"[] \<lozenge> bl = bl"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
85  | 
| "((a,b) # al) \<lozenge> bl = (a, b \<lhd> bl) # (al \<lozenge> bl)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
86  | 
|
| 44368 | 87  | 
lemma subst_Nil[simp]: "t \<lhd> [] = t"  | 
88  | 
by (induct t) auto  | 
|
89  | 
||
90  | 
lemma subst_mono: "t \<prec> u \<Longrightarrow> t \<lhd> s \<prec> u \<lhd> s"  | 
|
91  | 
by (induct u) auto  | 
|
92  | 
||
93  | 
lemma agreement: "(t \<lhd> r = t \<lhd> s) \<longleftrightarrow> (\<forall>v \<in> vars_of t. Var v \<lhd> r = Var v \<lhd> s)"  | 
|
94  | 
by (induct t) auto  | 
|
95  | 
||
96  | 
lemma repl_invariance: "v \<notin> vars_of t \<Longrightarrow> t \<lhd> (v,u) # s = t \<lhd> s"  | 
|
97  | 
by (simp add: agreement)  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
98  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
99  | 
lemma remove_var: "v \<notin> vars_of s \<Longrightarrow> v \<notin> vars_of (t \<lhd> [(v, s)])"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
100  | 
by (induct t) simp_all  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
101  | 
|
| 44368 | 102  | 
lemma subst_refl[iff]: "s \<doteq> s"  | 
103  | 
by (auto simp:subst_eq_def)  | 
|
104  | 
||
105  | 
lemma subst_sym[sym]: "\<lbrakk>s1 \<doteq> s2\<rbrakk> \<Longrightarrow> s2 \<doteq> s1"  | 
|
106  | 
by (auto simp:subst_eq_def)  | 
|
107  | 
||
108  | 
lemma subst_trans[trans]: "\<lbrakk>s1 \<doteq> s2; s2 \<doteq> s3\<rbrakk> \<Longrightarrow> s1 \<doteq> s3"  | 
|
109  | 
by (auto simp:subst_eq_def)  | 
|
110  | 
||
| 
44371
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
111  | 
lemma subst_no_occs: "\<not> Var v \<prec> t \<Longrightarrow> Var v \<noteq> t  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
112  | 
\<Longrightarrow> t \<lhd> [(v,s)] = t"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
113  | 
by (induct t) auto  | 
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
114  | 
|
| 44368 | 115  | 
lemma comp_Nil[simp]: "\<sigma> \<lozenge> [] = \<sigma>"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
116  | 
by (induct \<sigma>) auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
117  | 
|
| 44368 | 118  | 
lemma subst_comp[simp]: "t \<lhd> (r \<lozenge> s) = t \<lhd> r \<lhd> s"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
119  | 
proof (induct t)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
120  | 
case (Var v) thus ?case  | 
| 44368 | 121  | 
by (induct r) auto  | 
122  | 
qed auto  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
123  | 
|
| 44368 | 124  | 
lemma subst_eq_intro[intro]: "(\<And>t. t \<lhd> \<sigma> = t \<lhd> \<theta>) \<Longrightarrow> \<sigma> \<doteq> \<theta>"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
125  | 
by (auto simp:subst_eq_def)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
126  | 
|
| 44368 | 127  | 
lemma subst_eq_dest[dest]: "s1 \<doteq> s2 \<Longrightarrow> t \<lhd> s1 = t \<lhd> s2"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
128  | 
by (auto simp:subst_eq_def)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
129  | 
|
| 44368 | 130  | 
lemma comp_assoc: "(a \<lozenge> b) \<lozenge> c \<doteq> a \<lozenge> (b \<lozenge> c)"  | 
131  | 
by auto  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
132  | 
|
| 44368 | 133  | 
lemma subst_cong: "\<lbrakk>\<sigma> \<doteq> \<sigma>'; \<theta> \<doteq> \<theta>'\<rbrakk> \<Longrightarrow> (\<sigma> \<lozenge> \<theta>) \<doteq> (\<sigma>' \<lozenge> \<theta>')"  | 
134  | 
by (auto simp: subst_eq_def)  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
135  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
136  | 
lemma var_self: "[(v, Var v)] \<doteq> []"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
137  | 
proof  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
138  | 
fix t show "t \<lhd> [(v, Var v)] = t \<lhd> []"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
139  | 
by (induct t) simp_all  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
140  | 
qed  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
141  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
142  | 
lemma var_same[simp]: "[(v, t)] \<doteq> [] \<longleftrightarrow> t = Var v"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
143  | 
by (metis assoc.simps(2) subst.simps(1) subst_eq_def var_self)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
144  | 
|
| 23219 | 145  | 
|
| 44372 | 146  | 
subsection {* Unifiers and Most General Unifiers *}
 | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
147  | 
|
| 44368 | 148  | 
definition Unifier :: "'a subst \<Rightarrow> 'a trm \<Rightarrow> 'a trm \<Rightarrow> bool"  | 
149  | 
where "Unifier \<sigma> t u \<longleftrightarrow> (t \<lhd> \<sigma> = u \<lhd> \<sigma>)"  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
150  | 
|
| 44368 | 151  | 
definition MGU :: "'a subst \<Rightarrow> 'a trm \<Rightarrow> 'a trm \<Rightarrow> bool" where  | 
152  | 
"MGU \<sigma> t u \<longleftrightarrow>  | 
|
153  | 
Unifier \<sigma> t u \<and> (\<forall>\<theta>. Unifier \<theta> t u \<longrightarrow> (\<exists>\<gamma>. \<theta> \<doteq> \<sigma> \<lozenge> \<gamma>))"  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
154  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
155  | 
lemma MGUI[intro]:  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
156  | 
"\<lbrakk>t \<lhd> \<sigma> = u \<lhd> \<sigma>; \<And>\<theta>. t \<lhd> \<theta> = u \<lhd> \<theta> \<Longrightarrow> \<exists>\<gamma>. \<theta> \<doteq> \<sigma> \<lozenge> \<gamma>\<rbrakk>  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
157  | 
\<Longrightarrow> MGU \<sigma> t u"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
158  | 
by (simp only:Unifier_def MGU_def, auto)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
159  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
160  | 
lemma MGU_sym[sym]:  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
161  | 
"MGU \<sigma> s t \<Longrightarrow> MGU \<sigma> t s"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
162  | 
by (auto simp:MGU_def Unifier_def)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
163  | 
|
| 
44371
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
164  | 
lemma MGU_is_Unifier: "MGU \<sigma> t u \<Longrightarrow> Unifier \<sigma> t u"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
165  | 
unfolding MGU_def by (rule conjunct1)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
166  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
167  | 
lemma MGU_Var:  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
168  | 
assumes "\<not> Var v \<prec> t"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
169  | 
shows "MGU [(v,t)] (Var v) t"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
170  | 
proof (intro MGUI exI)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
171  | 
show "Var v \<lhd> [(v,t)] = t \<lhd> [(v,t)]" using assms  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
172  | 
by (metis assoc.simps(2) repl_invariance subst.simps(1) subst_Nil vars_iff_occseq)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
173  | 
next  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
174  | 
fix \<theta> assume th: "Var v \<lhd> \<theta> = t \<lhd> \<theta>"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
175  | 
show "\<theta> \<doteq> [(v,t)] \<lozenge> \<theta>"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
176  | 
proof  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
177  | 
fix s show "s \<lhd> \<theta> = s \<lhd> [(v,t)] \<lozenge> \<theta>" using th  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
178  | 
by (induct s) auto  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
179  | 
qed  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
180  | 
qed  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
181  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
182  | 
lemma MGU_Const: "MGU [] (Const c) (Const d) \<longleftrightarrow> c = d"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
183  | 
by (auto simp: MGU_def Unifier_def)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
184  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
185  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
186  | 
subsection {* The unification algorithm *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
187  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
188  | 
function unify :: "'a trm \<Rightarrow> 'a trm \<Rightarrow> 'a subst option"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
189  | 
where  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
190  | 
"unify (Const c) (M \<cdot> N) = None"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
191  | 
| "unify (M \<cdot> N) (Const c) = None"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
192  | 
| "unify (Const c) (Var v) = Some [(v, Const c)]"  | 
| 44369 | 193  | 
| "unify (M \<cdot> N) (Var v) = (if Var v \<prec> M \<cdot> N  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
194  | 
then None  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
195  | 
else Some [(v, M \<cdot> N)])"  | 
| 44369 | 196  | 
| "unify (Var v) M = (if Var v \<prec> M  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
197  | 
then None  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
198  | 
else Some [(v, M)])"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
199  | 
| "unify (Const c) (Const d) = (if c=d then Some [] else None)"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
200  | 
| "unify (M \<cdot> N) (M' \<cdot> N') = (case unify M M' of  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
201  | 
None \<Rightarrow> None |  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
202  | 
Some \<theta> \<Rightarrow> (case unify (N \<lhd> \<theta>) (N' \<lhd> \<theta>)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
203  | 
of None \<Rightarrow> None |  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
204  | 
Some \<sigma> \<Rightarrow> Some (\<theta> \<lozenge> \<sigma>)))"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
205  | 
by pat_completeness auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
206  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
207  | 
subsection {* Properties used in termination proof *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
208  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
209  | 
text {* Elimination of variables by a substitution: *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
210  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
211  | 
definition  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
212  | 
"elim \<sigma> v \<equiv> \<forall>t. v \<notin> vars_of (t \<lhd> \<sigma>)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
213  | 
|
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
214  | 
lemma elim_intro[intro]: "(\<And>t. v \<notin> vars_of (t \<lhd> \<sigma>)) \<Longrightarrow> elim \<sigma> v"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
215  | 
by (auto simp:elim_def)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
216  | 
|
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
217  | 
lemma elim_dest[dest]: "elim \<sigma> v \<Longrightarrow> v \<notin> vars_of (t \<lhd> \<sigma>)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
218  | 
by (auto simp:elim_def)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
219  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
220  | 
lemma elim_eq: "\<sigma> \<doteq> \<theta> \<Longrightarrow> elim \<sigma> x = elim \<theta> x"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
221  | 
by (auto simp:elim_def subst_eq_def)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
222  | 
|
| 44369 | 223  | 
lemma occs_elim: "\<not> Var v \<prec> t  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
224  | 
\<Longrightarrow> elim [(v,t)] v \<or> [(v,t)] \<doteq> []"  | 
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
225  | 
by (metis elim_intro remove_var var_same vars_iff_occseq)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
226  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
227  | 
text {* The result of a unification never introduces new variables: *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
228  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
229  | 
declare unify.psimps[simp]  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
230  | 
|
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
231  | 
lemma unify_vars:  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
232  | 
assumes "unify_dom (M, N)"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
233  | 
assumes "unify M N = Some \<sigma>"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
234  | 
shows "vars_of (t \<lhd> \<sigma>) \<subseteq> vars_of M \<union> vars_of N \<union> vars_of t"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
235  | 
(is "?P M N \<sigma> t")  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
236  | 
using assms  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
237  | 
proof (induct M N arbitrary:\<sigma> t)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
238  | 
case (3 c v)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
239  | 
hence "\<sigma> = [(v, Const c)]" by simp  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
240  | 
thus ?case by (induct t) auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
241  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
242  | 
case (4 M N v)  | 
| 44369 | 243  | 
hence "\<not> Var v \<prec> M \<cdot> N" by auto  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
244  | 
with 4 have "\<sigma> = [(v, M\<cdot>N)]" by simp  | 
| 
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
245  | 
thus ?case by (induct t) auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
246  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
247  | 
case (5 v M)  | 
| 44369 | 248  | 
hence "\<not> Var v \<prec> M" by auto  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
249  | 
with 5 have "\<sigma> = [(v, M)]" by simp  | 
| 
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
250  | 
thus ?case by (induct t) auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
251  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
252  | 
case (7 M N M' N' \<sigma>)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
253  | 
then obtain \<theta>1 \<theta>2  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
254  | 
where "unify M M' = Some \<theta>1"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
255  | 
and "unify (N \<lhd> \<theta>1) (N' \<lhd> \<theta>1) = Some \<theta>2"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
256  | 
and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
257  | 
and ih1: "\<And>t. ?P M M' \<theta>1 t"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
258  | 
and ih2: "\<And>t. ?P (N\<lhd>\<theta>1) (N'\<lhd>\<theta>1) \<theta>2 t"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
259  | 
by (auto split:option.split_asm)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
260  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
261  | 
show ?case  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
262  | 
proof  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
263  | 
fix v assume a: "v \<in> vars_of (t \<lhd> \<sigma>)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
264  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
265  | 
show "v \<in> vars_of (M \<cdot> N) \<union> vars_of (M' \<cdot> N') \<union> vars_of t"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
266  | 
proof (cases "v \<notin> vars_of M \<and> v \<notin> vars_of M'  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
267  | 
\<and> v \<notin> vars_of N \<and> v \<notin> vars_of N'")  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
268  | 
case True  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
269  | 
with ih1 have l:"\<And>t. v \<in> vars_of (t \<lhd> \<theta>1) \<Longrightarrow> v \<in> vars_of t"  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
270  | 
by auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
271  | 
|
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
272  | 
from a and ih2[where t="t \<lhd> \<theta>1"]  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
273  | 
have "v \<in> vars_of (N \<lhd> \<theta>1) \<union> vars_of (N' \<lhd> \<theta>1)  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
274  | 
\<or> v \<in> vars_of (t \<lhd> \<theta>1)" unfolding \<sigma>  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
275  | 
by auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
276  | 
hence "v \<in> vars_of t"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
277  | 
proof  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
278  | 
assume "v \<in> vars_of (N \<lhd> \<theta>1) \<union> vars_of (N' \<lhd> \<theta>1)"  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
279  | 
with True show ?thesis by (auto dest:l)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
280  | 
next  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
281  | 
assume "v \<in> vars_of (t \<lhd> \<theta>1)"  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
282  | 
thus ?thesis by (rule l)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
283  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
284  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
285  | 
thus ?thesis by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
286  | 
qed auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
287  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
288  | 
qed (auto split: split_if_asm)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
289  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
290  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
291  | 
text {* The result of a unification is either the identity
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
292  | 
substitution or it eliminates a variable from one of the terms: *}  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
293  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
294  | 
lemma unify_eliminates:  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
295  | 
assumes "unify_dom (M, N)"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
296  | 
assumes "unify M N = Some \<sigma>"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
297  | 
shows "(\<exists>v\<in>vars_of M \<union> vars_of N. elim \<sigma> v) \<or> \<sigma> \<doteq> []"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
298  | 
(is "?P M N \<sigma>")  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
299  | 
using assms  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
300  | 
proof (induct M N arbitrary:\<sigma>)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
301  | 
case 1 thus ?case by simp  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
302  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
303  | 
case 2 thus ?case by simp  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
304  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
305  | 
case (3 c v)  | 
| 44369 | 306  | 
have no_occs: "\<not> Var v \<prec> Const c" by simp  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
307  | 
with 3 have "\<sigma> = [(v, Const c)]" by simp  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
308  | 
with occs_elim[OF no_occs]  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
309  | 
show ?case by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
310  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
311  | 
case (4 M N v)  | 
| 44369 | 312  | 
hence no_occs: "\<not> Var v \<prec> M \<cdot> N" by auto  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
313  | 
with 4 have "\<sigma> = [(v, M\<cdot>N)]" by simp  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
314  | 
with occs_elim[OF no_occs]  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
315  | 
show ?case by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
316  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
317  | 
case (5 v M)  | 
| 44369 | 318  | 
hence no_occs: "\<not> Var v \<prec> M" by auto  | 
| 
24444
 
448978b61556
induct: proper separation of initial and terminal step;
 
wenzelm 
parents: 
23777 
diff
changeset
 | 
319  | 
with 5 have "\<sigma> = [(v, M)]" by simp  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
320  | 
with occs_elim[OF no_occs]  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
321  | 
show ?case by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
322  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
323  | 
case (6 c d) thus ?case  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
324  | 
by (cases "c = d") auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
325  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
326  | 
case (7 M N M' N' \<sigma>)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
327  | 
then obtain \<theta>1 \<theta>2  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
328  | 
where "unify M M' = Some \<theta>1"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
329  | 
and "unify (N \<lhd> \<theta>1) (N' \<lhd> \<theta>1) = Some \<theta>2"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
330  | 
and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
331  | 
and ih1: "?P M M' \<theta>1"  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
332  | 
and ih2: "?P (N\<lhd>\<theta>1) (N'\<lhd>\<theta>1) \<theta>2"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
333  | 
by (auto split:option.split_asm)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
334  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
335  | 
from `unify_dom (M \<cdot> N, M' \<cdot> N')`  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
336  | 
have "unify_dom (M, M')"  | 
| 23777 | 337  | 
by (rule accp_downward) (rule unify_rel.intros)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
338  | 
hence no_new_vars:  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
339  | 
"\<And>t. vars_of (t \<lhd> \<theta>1) \<subseteq> vars_of M \<union> vars_of M' \<union> vars_of t"  | 
| 23373 | 340  | 
by (rule unify_vars) (rule `unify M M' = Some \<theta>1`)  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
341  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
342  | 
from ih2 show ?case  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
343  | 
proof  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
344  | 
assume "\<exists>v\<in>vars_of (N \<lhd> \<theta>1) \<union> vars_of (N' \<lhd> \<theta>1). elim \<theta>2 v"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
345  | 
then obtain v  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
346  | 
where "v\<in>vars_of (N \<lhd> \<theta>1) \<union> vars_of (N' \<lhd> \<theta>1)"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
347  | 
and el: "elim \<theta>2 v" by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
348  | 
with no_new_vars show ?thesis unfolding \<sigma>  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
349  | 
by (auto simp:elim_def)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
350  | 
next  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
351  | 
assume empty[simp]: "\<theta>2 \<doteq> []"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
352  | 
|
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
353  | 
have "\<sigma> \<doteq> (\<theta>1 \<lozenge> [])" unfolding \<sigma>  | 
| 44368 | 354  | 
by (rule subst_cong) auto  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
355  | 
also have "\<dots> \<doteq> \<theta>1" by auto  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
356  | 
finally have "\<sigma> \<doteq> \<theta>1" .  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
357  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
358  | 
from ih1 show ?thesis  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
359  | 
proof  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
360  | 
assume "\<exists>v\<in>vars_of M \<union> vars_of M'. elim \<theta>1 v"  | 
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
361  | 
with elim_eq[OF `\<sigma> \<doteq> \<theta>1`]  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
362  | 
show ?thesis by auto  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
363  | 
next  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
364  | 
note `\<sigma> \<doteq> \<theta>1`  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
365  | 
also assume "\<theta>1 \<doteq> []"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
366  | 
finally show ?thesis ..  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
367  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
368  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
369  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
370  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
371  | 
declare unify.psimps[simp del]  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
372  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
373  | 
subsection {* Termination proof *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
374  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
375  | 
termination unify  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
376  | 
proof  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
377  | 
let ?R = "measures [\<lambda>(M,N). card (vars_of M \<union> vars_of N),  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
378  | 
\<lambda>(M, N). size M]"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
379  | 
show "wf ?R" by simp  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
380  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
381  | 
fix M N M' N' :: "'a trm"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
382  | 
show "((M, M'), (M \<cdot> N, M' \<cdot> N')) \<in> ?R" -- "Inner call"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
383  | 
by (rule measures_lesseq) (auto intro: card_mono)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
384  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
385  | 
fix \<theta> -- "Outer call"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
386  | 
assume inner: "unify_dom (M, M')"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
387  | 
"unify M M' = Some \<theta>"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
388  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
389  | 
from unify_eliminates[OF inner]  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
390  | 
show "((N \<lhd> \<theta>, N' \<lhd> \<theta>), (M \<cdot> N, M' \<cdot> N')) \<in>?R"  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
391  | 
proof  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
392  | 
    -- {* Either a variable is eliminated \ldots *}
 | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
393  | 
assume "(\<exists>v\<in>vars_of M \<union> vars_of M'. elim \<theta> v)"  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
394  | 
then obtain v  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
395  | 
where "elim \<theta> v"  | 
| 
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
396  | 
and "v\<in>vars_of M \<union> vars_of M'" by auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
397  | 
with unify_vars[OF inner]  | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
398  | 
have "vars_of (N\<lhd>\<theta>) \<union> vars_of (N'\<lhd>\<theta>)  | 
| 
32960
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
399  | 
\<subset> vars_of (M\<cdot>N) \<union> vars_of (M'\<cdot>N')"  | 
| 
 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 
wenzelm 
parents: 
30909 
diff
changeset
 | 
400  | 
by auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
401  | 
|
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
402  | 
thus ?thesis  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
403  | 
by (auto intro!: measures_less intro: psubset_card_mono)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
404  | 
next  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
405  | 
    -- {* Or the substitution is empty *}
 | 
| 
44367
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
406  | 
assume "\<theta> \<doteq> []"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
407  | 
hence "N \<lhd> \<theta> = N"  | 
| 
 
74c08021ab2e
changed constant names and notation to match HOL/Subst/*.thy, from which this theory is a clone.
 
krauss 
parents: 
42463 
diff
changeset
 | 
408  | 
and "N' \<lhd> \<theta> = N'" by auto  | 
| 
22999
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
409  | 
thus ?thesis  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
410  | 
by (auto intro!: measures_less intro: psubset_card_mono)  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
411  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
412  | 
qed  | 
| 
 
c1ce129e6f9c
Added unification case study (using new function package)
 
krauss 
parents:  
diff
changeset
 | 
413  | 
|
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
414  | 
|
| 44372 | 415  | 
subsection {* Unification returns a Most General Unifier *}
 | 
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
416  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
417  | 
lemma unify_computes_MGU:  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
418  | 
"unify M N = Some \<sigma> \<Longrightarrow> MGU \<sigma> M N"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
419  | 
proof (induct M N arbitrary: \<sigma> rule: unify.induct)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
420  | 
case (7 M N M' N' \<sigma>) -- "The interesting case"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
421  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
422  | 
then obtain \<theta>1 \<theta>2  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
423  | 
where "unify M M' = Some \<theta>1"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
424  | 
and "unify (N \<lhd> \<theta>1) (N' \<lhd> \<theta>1) = Some \<theta>2"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
425  | 
and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
426  | 
and MGU_inner: "MGU \<theta>1 M M'"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
427  | 
and MGU_outer: "MGU \<theta>2 (N \<lhd> \<theta>1) (N' \<lhd> \<theta>1)"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
428  | 
by (auto split:option.split_asm)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
429  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
430  | 
show ?case  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
431  | 
proof  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
432  | 
from MGU_inner and MGU_outer  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
433  | 
have "M \<lhd> \<theta>1 = M' \<lhd> \<theta>1"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
434  | 
and "N \<lhd> \<theta>1 \<lhd> \<theta>2 = N' \<lhd> \<theta>1 \<lhd> \<theta>2"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
435  | 
unfolding MGU_def Unifier_def  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
436  | 
by auto  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
437  | 
thus "M \<cdot> N \<lhd> \<sigma> = M' \<cdot> N' \<lhd> \<sigma>" unfolding \<sigma>  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
438  | 
by simp  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
439  | 
next  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
440  | 
fix \<sigma>' assume "M \<cdot> N \<lhd> \<sigma>' = M' \<cdot> N' \<lhd> \<sigma>'"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
441  | 
hence "M \<lhd> \<sigma>' = M' \<lhd> \<sigma>'"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
442  | 
and Ns: "N \<lhd> \<sigma>' = N' \<lhd> \<sigma>'" by auto  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
443  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
444  | 
with MGU_inner obtain \<delta>  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
445  | 
where eqv: "\<sigma>' \<doteq> \<theta>1 \<lozenge> \<delta>"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
446  | 
unfolding MGU_def Unifier_def  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
447  | 
by auto  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
448  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
449  | 
from Ns have "N \<lhd> \<theta>1 \<lhd> \<delta> = N' \<lhd> \<theta>1 \<lhd> \<delta>"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
450  | 
by (simp add:subst_eq_dest[OF eqv])  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
451  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
452  | 
with MGU_outer obtain \<rho>  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
453  | 
where eqv2: "\<delta> \<doteq> \<theta>2 \<lozenge> \<rho>"  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
454  | 
unfolding MGU_def Unifier_def  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
455  | 
by auto  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
456  | 
|
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
457  | 
have "\<sigma>' \<doteq> \<sigma> \<lozenge> \<rho>" unfolding \<sigma>  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
458  | 
by (rule subst_eq_intro, auto simp:subst_eq_dest[OF eqv] subst_eq_dest[OF eqv2])  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
459  | 
thus "\<exists>\<gamma>. \<sigma>' \<doteq> \<sigma> \<lozenge> \<gamma>" ..  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
460  | 
qed  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
461  | 
qed (auto simp: MGU_Const intro: MGU_Var MGU_Var[symmetric] split: split_if_asm)  | 
| 
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
462  | 
|
| 44372 | 463  | 
|
464  | 
subsection {* Unification returns Idempotent Substitution *}
 | 
|
465  | 
||
466  | 
definition Idem :: "'a subst \<Rightarrow> bool"  | 
|
467  | 
where "Idem s \<longleftrightarrow> (s \<lozenge> s) \<doteq> s"  | 
|
468  | 
||
| 
44371
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
469  | 
lemma Idem_Nil [iff]: "Idem []"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
470  | 
by (simp add: Idem_def)  | 
| 
44370
 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 
krauss 
parents: 
44369 
diff
changeset
 | 
471  | 
|
| 
44371
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
472  | 
lemma Var_Idem:  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
473  | 
assumes "~ (Var v \<prec> t)" shows "Idem [(v,t)]"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
474  | 
unfolding Idem_def  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
475  | 
proof  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
476  | 
from assms have [simp]: "t \<lhd> [(v, t)] = t"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
477  | 
by (metis assoc.simps(2) subst.simps(1) subst_no_occs)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
478  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
479  | 
fix s show "s \<lhd> [(v, t)] \<lozenge> [(v, t)] = s \<lhd> [(v, t)]"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
480  | 
by (induct s) auto  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
481  | 
qed  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
482  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
483  | 
lemma Unifier_Idem_subst:  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
484  | 
"Idem(r) \<Longrightarrow> Unifier s (t \<lhd> r) (u \<lhd> r) \<Longrightarrow>  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
485  | 
Unifier (r \<lozenge> s) (t \<lhd> r) (u \<lhd> r)"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
486  | 
by (simp add: Idem_def Unifier_def subst_eq_def)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
487  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
488  | 
lemma Idem_comp:  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
489  | 
"Idem r \<Longrightarrow> Unifier s (t \<lhd> r) (u \<lhd> r) \<Longrightarrow>  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
490  | 
(!!q. Unifier q (t \<lhd> r) (u \<lhd> r) \<Longrightarrow> s \<lozenge> q \<doteq> q) \<Longrightarrow>  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
491  | 
Idem (r \<lozenge> s)"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
492  | 
apply (frule Unifier_Idem_subst, blast)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
493  | 
apply (force simp add: Idem_def subst_eq_def)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
494  | 
done  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
495  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
496  | 
theorem unify_gives_Idem:  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
497  | 
"unify M N = Some \<sigma> \<Longrightarrow> Idem \<sigma>"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
498  | 
proof (induct M N arbitrary: \<sigma> rule: unify.induct)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
499  | 
case (7 M M' N N' \<sigma>)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
500  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
501  | 
then obtain \<theta>1 \<theta>2  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
502  | 
where "unify M N = Some \<theta>1"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
503  | 
and \<theta>2: "unify (M' \<lhd> \<theta>1) (N' \<lhd> \<theta>1) = Some \<theta>2"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
504  | 
and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
505  | 
and "Idem \<theta>1"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
506  | 
and "Idem \<theta>2"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
507  | 
by (auto split: option.split_asm)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
508  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
509  | 
from \<theta>2 have "Unifier \<theta>2 (M' \<lhd> \<theta>1) (N' \<lhd> \<theta>1)"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
510  | 
by (rule unify_computes_MGU[THEN MGU_is_Unifier])  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
511  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
512  | 
with `Idem \<theta>1`  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
513  | 
show "Idem \<sigma>" unfolding \<sigma>  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
514  | 
proof (rule Idem_comp)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
515  | 
fix \<sigma> assume "Unifier \<sigma> (M' \<lhd> \<theta>1) (N' \<lhd> \<theta>1)"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
516  | 
with \<theta>2 obtain \<gamma> where \<sigma>: "\<sigma> \<doteq> \<theta>2 \<lozenge> \<gamma>"  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
517  | 
using unify_computes_MGU MGU_def by blast  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
518  | 
|
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
519  | 
have "\<theta>2 \<lozenge> \<sigma> \<doteq> \<theta>2 \<lozenge> (\<theta>2 \<lozenge> \<gamma>)" by (rule subst_cong) (auto simp: \<sigma>)  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
520  | 
also have "... \<doteq> (\<theta>2 \<lozenge> \<theta>2) \<lozenge> \<gamma>" by (rule comp_assoc[symmetric])  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
521  | 
also have "... \<doteq> \<theta>2 \<lozenge> \<gamma>" by (rule subst_cong) (auto simp: `Idem \<theta>2`[unfolded Idem_def])  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
522  | 
also have "... \<doteq> \<sigma>" by (rule \<sigma>[symmetric])  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
523  | 
finally show "\<theta>2 \<lozenge> \<sigma> \<doteq> \<sigma>" .  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
524  | 
qed  | 
| 
 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 
krauss 
parents: 
44370 
diff
changeset
 | 
525  | 
qed (auto intro!: Var_Idem split: option.splits if_splits)  | 
| 39754 | 526  | 
|
| 23219 | 527  | 
end  |