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