| author | wenzelm | 
| Sat, 29 Jun 2013 20:25:33 +0200 | |
| changeset 52481 | d977e7eb7839 | 
| 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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
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: 
44369diff
changeset | 100 | by (induct t) simp_all | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44370diff
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: 
44370diff
changeset | 112 | \<Longrightarrow> t \<lhd> [(v,s)] = t" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 113 | by (induct t) auto | 
| 44370 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
changeset | 136 | lemma var_self: "[(v, Var v)] \<doteq> []" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 137 | proof | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 138 | fix t show "t \<lhd> [(v, Var v)] = t \<lhd> []" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 139 | by (induct t) simp_all | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 140 | qed | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 141 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 142 | lemma var_same[simp]: "[(v, t)] \<doteq> [] \<longleftrightarrow> t = Var v" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
42463diff
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: 
44370diff
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: 
44370diff
changeset | 165 | unfolding MGU_def by (rule conjunct1) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 166 | |
| 44370 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 167 | lemma MGU_Var: | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 168 | assumes "\<not> Var v \<prec> t" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 169 | shows "MGU [(v,t)] (Var v) t" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 170 | proof (intro MGUI exI) | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 171 | show "Var v \<lhd> [(v,t)] = t \<lhd> [(v,t)]" using assms | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 173 | next | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 174 | fix \<theta> assume th: "Var v \<lhd> \<theta> = t \<lhd> \<theta>" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 175 | show "\<theta> \<doteq> [(v,t)] \<lozenge> \<theta>" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 176 | proof | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 178 | by (induct s) auto | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 179 | qed | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 180 | qed | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 181 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 182 | lemma MGU_Const: "MGU [] (Const c) (Const d) \<longleftrightarrow> c = d" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 183 | by (auto simp: MGU_def Unifier_def) | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
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: 
42463diff
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: 
42463diff
changeset | 224 | \<Longrightarrow> elim [(v,t)] v \<or> [(v,t)] \<doteq> []" | 
| 44370 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 229 | declare unify.psimps[simp] | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
42463diff
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: 
23777diff
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: 
23777diff
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: 
23777diff
changeset | 244 | with 4 have "\<sigma> = [(v, M\<cdot>N)]" by simp | 
| 
448978b61556
induct: proper separation of initial and terminal step;
 wenzelm parents: 
23777diff
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: 
23777diff
changeset | 249 | with 5 have "\<sigma> = [(v, M)]" by simp | 
| 
448978b61556
induct: proper separation of initial and terminal step;
 wenzelm parents: 
23777diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
30909diff
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: 
42463diff
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: 
30909diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
30909diff
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: 
42463diff
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: 
30909diff
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: 
42463diff
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: 
30909diff
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: 
42463diff
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: 
23777diff
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: 
23777diff
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: 
42463diff
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: 
23777diff
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: 
42463diff
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: 
23777diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
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: 
44369diff
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: 
42463diff
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: 
30909diff
changeset | 395 | where "elim \<theta> v" | 
| 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
30909diff
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: 
42463diff
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: 
30909diff
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: 
30909diff
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: 
42463diff
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: 
42463diff
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: 
42463diff
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: 
44369diff
changeset | 414 | |
| 44372 | 415 | subsection {* Unification returns a Most General Unifier *}
 | 
| 44370 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 416 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 417 | lemma unify_computes_MGU: | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 418 | "unify M N = Some \<sigma> \<Longrightarrow> MGU \<sigma> M N" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 419 | proof (induct M N arbitrary: \<sigma> rule: unify.induct) | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 420 | case (7 M N M' N' \<sigma>) -- "The interesting case" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 421 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 422 | then obtain \<theta>1 \<theta>2 | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 423 | where "unify M M' = Some \<theta>1" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 424 | and "unify (N \<lhd> \<theta>1) (N' \<lhd> \<theta>1) = Some \<theta>2" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 425 | and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 426 | and MGU_inner: "MGU \<theta>1 M M'" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 428 | by (auto split:option.split_asm) | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 429 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 430 | show ?case | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 431 | proof | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 432 | from MGU_inner and MGU_outer | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 433 | have "M \<lhd> \<theta>1 = M' \<lhd> \<theta>1" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 435 | unfolding MGU_def Unifier_def | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 436 | by auto | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 437 | thus "M \<cdot> N \<lhd> \<sigma> = M' \<cdot> N' \<lhd> \<sigma>" unfolding \<sigma> | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 438 | by simp | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 439 | next | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 440 | fix \<sigma>' assume "M \<cdot> N \<lhd> \<sigma>' = M' \<cdot> N' \<lhd> \<sigma>'" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 441 | hence "M \<lhd> \<sigma>' = M' \<lhd> \<sigma>'" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 442 | and Ns: "N \<lhd> \<sigma>' = N' \<lhd> \<sigma>'" by auto | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 443 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 444 | with MGU_inner obtain \<delta> | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 445 | where eqv: "\<sigma>' \<doteq> \<theta>1 \<lozenge> \<delta>" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 446 | unfolding MGU_def Unifier_def | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 447 | by auto | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 448 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 450 | by (simp add:subst_eq_dest[OF eqv]) | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 451 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 452 | with MGU_outer obtain \<rho> | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 453 | where eqv2: "\<delta> \<doteq> \<theta>2 \<lozenge> \<rho>" | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 454 | unfolding MGU_def Unifier_def | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 455 | by auto | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 456 | |
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 457 | have "\<sigma>' \<doteq> \<sigma> \<lozenge> \<rho>" unfolding \<sigma> | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
changeset | 459 | thus "\<exists>\<gamma>. \<sigma>' \<doteq> \<sigma> \<lozenge> \<gamma>" .. | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 460 | qed | 
| 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
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: 
44369diff
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: 
44370diff
changeset | 469 | lemma Idem_Nil [iff]: "Idem []" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 470 | by (simp add: Idem_def) | 
| 44370 
03d91bfad83b
tuned proofs, sledgehammering overly verbose parts
 krauss parents: 
44369diff
changeset | 471 | |
| 44371 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 472 | lemma Var_Idem: | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 473 | assumes "~ (Var v \<prec> t)" shows "Idem [(v,t)]" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 474 | unfolding Idem_def | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 475 | proof | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 476 | from assms have [simp]: "t \<lhd> [(v, t)] = t" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
changeset | 478 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
changeset | 480 | by (induct s) auto | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 481 | qed | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 482 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 483 | lemma Unifier_Idem_subst: | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
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: 
44370diff
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: 
44370diff
changeset | 487 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 488 | lemma Idem_comp: | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
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: 
44370diff
changeset | 491 | Idem (r \<lozenge> s)" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 492 | apply (frule Unifier_Idem_subst, blast) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 493 | apply (force simp add: Idem_def subst_eq_def) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 494 | done | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 495 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 496 | theorem unify_gives_Idem: | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 497 | "unify M N = Some \<sigma> \<Longrightarrow> Idem \<sigma>" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 498 | proof (induct M N arbitrary: \<sigma> rule: unify.induct) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 499 | case (7 M M' N N' \<sigma>) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 500 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 501 | then obtain \<theta>1 \<theta>2 | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 502 | where "unify M N = Some \<theta>1" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
changeset | 504 | and \<sigma>: "\<sigma> = \<theta>1 \<lozenge> \<theta>2" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 505 | and "Idem \<theta>1" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 506 | and "Idem \<theta>2" | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 507 | by (auto split: option.split_asm) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 508 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
changeset | 510 | by (rule unify_computes_MGU[THEN MGU_is_Unifier]) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 511 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 512 | with `Idem \<theta>1` | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 513 | show "Idem \<sigma>" unfolding \<sigma> | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 514 | proof (rule Idem_comp) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
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: 
44370diff
changeset | 517 | using unify_computes_MGU MGU_def by blast | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 518 | |
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
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: 
44370diff
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: 
44370diff
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: 
44370diff
changeset | 522 | also have "... \<doteq> \<sigma>" by (rule \<sigma>[symmetric]) | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 523 | finally show "\<theta>2 \<lozenge> \<sigma> \<doteq> \<sigma>" . | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 524 | qed | 
| 
3a10392fb8c3
added proof of idempotence, roughly after HOL/Subst/Unify.thy
 krauss parents: 
44370diff
changeset | 525 | qed (auto intro!: Var_Idem split: option.splits if_splits) | 
| 39754 | 526 | |
| 23219 | 527 | end |