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