# Theory Unification

theory Unification
imports Main
```(*  Title:      HOL/ex/Unification.thy
Author:     Martin Coen, Cambridge University Computer Laboratory
Author:     Konrad Slind, TUM & Cambridge University Computer Laboratory
Author:     Alexander Krauss, TUM
*)

section ‹Substitution and Unification›

theory Unification
imports Main
begin

text ‹
Implements Manna \& Waldinger's formalization, with Paulson's
simplifications, and some new simplifications by Slind and Krauss.

Z Manna \& R Waldinger, Deductive Synthesis of the Unification
Algorithm.  SCP 1 (1981), 5-48

L C Paulson, Verifying the Unification Algorithm in LCF. SCP 5
(1985), 143-170

K Slind, Reasoning about Terminating Functional Programs,
Ph.D. thesis, TUM, 1999, Sect. 5.8

A Krauss, Partial and Nested Recursive Function Definitions in
Higher-Order Logic, JAR 44(4):303-336, 2010. Sect. 6.3
›

subsection ‹Terms›

text ‹Binary trees with leaves that are constants or variables.›

datatype 'a trm =
Var 'a
| Const 'a
| Comb "'a trm" "'a trm" (infix "⋅" 60)

primrec vars_of :: "'a trm ⇒ 'a set"
where
"vars_of (Var v) = {v}"
| "vars_of (Const c) = {}"
| "vars_of (M ⋅ N) = vars_of M ∪ vars_of N"

fun occs :: "'a trm ⇒ 'a trm ⇒ bool" (infixl "≺" 54)
where
"u ≺ Var v ⟷ False"
| "u ≺ Const c ⟷ False"
| "u ≺ M ⋅ N ⟷ u = M ∨ u = N ∨ u ≺ M ∨ u ≺ N"

lemma finite_vars_of[intro]: "finite (vars_of t)"
by (induct t) simp_all

lemma vars_iff_occseq: "x ∈ vars_of t ⟷ Var x ≺ t ∨ Var x = t"
by (induct t) auto

lemma occs_vars_subset: "M ≺ N ⟹ vars_of M ⊆ vars_of N"
by (induct N) auto

subsection ‹Substitutions›

type_synonym 'a subst = "('a × 'a trm) list"

fun assoc :: "'a ⇒ 'b ⇒ ('a × 'b) list ⇒ 'b"
where
"assoc x d [] = d"
| "assoc x d ((p,q)#t) = (if x = p then q else assoc x d t)"

primrec subst :: "'a trm ⇒ 'a subst ⇒ 'a trm" (infixl "⊲" 55)
where
"(Var v) ⊲ s = assoc v (Var v) s"
| "(Const c) ⊲ s = (Const c)"
| "(M ⋅ N) ⊲ s = (M ⊲ s) ⋅ (N ⊲ s)"

definition subst_eq (infixr "≐" 52)
where
"s1 ≐ s2 ⟷ (∀t. t ⊲ s1 = t ⊲ s2)"

fun comp :: "'a subst ⇒ 'a subst ⇒ 'a subst" (infixl "◊" 56)
where
"[] ◊ bl = bl"
| "((a,b) # al) ◊ bl = (a, b ⊲ bl) # (al ◊ bl)"

lemma subst_Nil[simp]: "t ⊲ [] = t"
by (induct t) auto

lemma subst_mono: "t ≺ u ⟹ t ⊲ s ≺ u ⊲ s"
by (induct u) auto

lemma agreement: "(t ⊲ r = t ⊲ s) ⟷ (∀v ∈ vars_of t. Var v ⊲ r = Var v ⊲ s)"
by (induct t) auto

lemma repl_invariance: "v ∉ vars_of t ⟹ t ⊲ (v,u) # s = t ⊲ s"

lemma remove_var: "v ∉ vars_of s ⟹ v ∉ vars_of (t ⊲ [(v, s)])"
by (induct t) simp_all

lemma subst_refl[iff]: "s ≐ s"
by (auto simp:subst_eq_def)

lemma subst_sym[sym]: "⟦s1 ≐ s2⟧ ⟹ s2 ≐ s1"
by (auto simp:subst_eq_def)

lemma subst_trans[trans]: "⟦s1 ≐ s2; s2 ≐ s3⟧ ⟹ s1 ≐ s3"
by (auto simp:subst_eq_def)

lemma subst_no_occs: "¬ Var v ≺ t ⟹ Var v ≠ t
⟹ t ⊲ [(v,s)] = t"
by (induct t) auto

lemma comp_Nil[simp]: "σ ◊ [] = σ"
by (induct σ) auto

lemma subst_comp[simp]: "t ⊲ (r ◊ s) = t ⊲ r ⊲ s"
proof (induct t)
case (Var v) thus ?case
by (induct r) auto
qed auto

lemma subst_eq_intro[intro]: "(⋀t. t ⊲ σ = t ⊲ θ) ⟹ σ ≐ θ"
by (auto simp:subst_eq_def)

lemma subst_eq_dest[dest]: "s1 ≐ s2 ⟹ t ⊲ s1 = t ⊲ s2"
by (auto simp:subst_eq_def)

lemma comp_assoc: "(a ◊ b) ◊ c ≐ a ◊ (b ◊ c)"
by auto

lemma subst_cong: "⟦σ ≐ σ'; θ ≐ θ'⟧ ⟹ (σ ◊ θ) ≐ (σ' ◊ θ')"
by (auto simp: subst_eq_def)

lemma var_self: "[(v, Var v)] ≐ []"
proof
fix t show "t ⊲ [(v, Var v)] = t ⊲ []"
by (induct t) simp_all
qed

lemma var_same[simp]: "[(v, t)] ≐ [] ⟷ t = Var v"
by (metis assoc.simps(2) subst.simps(1) subst_eq_def var_self)

subsection ‹Unifiers and Most General Unifiers›

definition Unifier :: "'a subst ⇒ 'a trm ⇒ 'a trm ⇒ bool"
where "Unifier σ t u ⟷ (t ⊲ σ = u ⊲ σ)"

definition MGU :: "'a subst ⇒ 'a trm ⇒ 'a trm ⇒ bool" where
"MGU σ t u ⟷
Unifier σ t u ∧ (∀θ. Unifier θ t u ⟶ (∃γ. θ ≐ σ ◊ γ))"

lemma MGUI[intro]:
"⟦t ⊲ σ = u ⊲ σ; ⋀θ. t ⊲ θ = u ⊲ θ ⟹ ∃γ. θ ≐ σ ◊ γ⟧
⟹ MGU σ t u"
by (simp only:Unifier_def MGU_def, auto)

lemma MGU_sym[sym]:
"MGU σ s t ⟹ MGU σ t s"
by (auto simp:MGU_def Unifier_def)

lemma MGU_is_Unifier: "MGU σ t u ⟹ Unifier σ t u"
unfolding MGU_def by (rule conjunct1)

lemma MGU_Var:
assumes "¬ Var v ≺ t"
shows "MGU [(v,t)] (Var v) t"
proof (intro MGUI exI)
show "Var v ⊲ [(v,t)] = t ⊲ [(v,t)]" using assms
by (metis assoc.simps(2) repl_invariance subst.simps(1) subst_Nil vars_iff_occseq)
next
fix θ assume th: "Var v ⊲ θ = t ⊲ θ"
show "θ ≐ [(v,t)] ◊ θ"
proof
fix s show "s ⊲ θ = s ⊲ [(v,t)] ◊ θ" using th
by (induct s) auto
qed
qed

lemma MGU_Const: "MGU [] (Const c) (Const d) ⟷ c = d"
by (auto simp: MGU_def Unifier_def)

subsection ‹The unification algorithm›

function unify :: "'a trm ⇒ 'a trm ⇒ 'a subst option"
where
"unify (Const c) (M ⋅ N)   = None"
| "unify (M ⋅ N)   (Const c) = None"
| "unify (Const c) (Var v)   = Some [(v, Const c)]"
| "unify (M ⋅ N)   (Var v)   = (if Var v ≺ M ⋅ N
then None
else Some [(v, M ⋅ N)])"
| "unify (Var v)   M         = (if Var v ≺ M
then None
else Some [(v, M)])"
| "unify (Const c) (Const d) = (if c=d then Some [] else None)"
| "unify (M ⋅ N) (M' ⋅ N') = (case unify M M' of
None ⇒ None |
Some θ ⇒ (case unify (N ⊲ θ) (N' ⊲ θ)
of None ⇒ None |
Some σ ⇒ Some (θ ◊ σ)))"
by pat_completeness auto

subsection ‹Properties used in termination proof›

text ‹Elimination of variables by a substitution:›

definition
"elim σ v ≡ ∀t. v ∉ vars_of (t ⊲ σ)"

lemma elim_intro[intro]: "(⋀t. v ∉ vars_of (t ⊲ σ)) ⟹ elim σ v"
by (auto simp:elim_def)

lemma elim_dest[dest]: "elim σ v ⟹ v ∉ vars_of (t ⊲ σ)"
by (auto simp:elim_def)

lemma elim_eq: "σ ≐ θ ⟹ elim σ x = elim θ x"
by (auto simp:elim_def subst_eq_def)

lemma occs_elim: "¬ Var v ≺ t
⟹ elim [(v,t)] v ∨ [(v,t)] ≐ []"
by (metis elim_intro remove_var var_same vars_iff_occseq)

text ‹The result of a unification never introduces new variables:›

declare unify.psimps[simp]

lemma unify_vars:
assumes "unify_dom (M, N)"
assumes "unify M N = Some σ"
shows "vars_of (t ⊲ σ) ⊆ vars_of M ∪ vars_of N ∪ vars_of t"
(is "?P M N σ t")
using assms
proof (induct M N arbitrary:σ t)
case (3 c v)
hence "σ = [(v, Const c)]" by simp
thus ?case by (induct t) auto
next
case (4 M N v)
hence "¬ Var v ≺ M ⋅ N" by auto
with 4 have "σ = [(v, M⋅N)]" by simp
thus ?case by (induct t) auto
next
case (5 v M)
hence "¬ Var v ≺ M" by auto
with 5 have "σ = [(v, M)]" by simp
thus ?case by (induct t) auto
next
case (7 M N M' N' σ)
then obtain θ1 θ2
where "unify M M' = Some θ1"
and "unify (N ⊲ θ1) (N' ⊲ θ1) = Some θ2"
and σ: "σ = θ1 ◊ θ2"
and ih1: "⋀t. ?P M M' θ1 t"
and ih2: "⋀t. ?P (N⊲θ1) (N'⊲θ1) θ2 t"
by (auto split:option.split_asm)

show ?case
proof
fix v assume a: "v ∈ vars_of (t ⊲ σ)"

show "v ∈ vars_of (M ⋅ N) ∪ vars_of (M' ⋅ N') ∪ vars_of t"
proof (cases "v ∉ vars_of M ∧ v ∉ vars_of M'
∧ v ∉ vars_of N ∧ v ∉ vars_of N'")
case True
with ih1 have l:"⋀t. v ∈ vars_of (t ⊲ θ1) ⟹ v ∈ vars_of t"
by auto

from a and ih2[where t="t ⊲ θ1"]
have "v ∈ vars_of (N ⊲ θ1) ∪ vars_of (N' ⊲ θ1)
∨ v ∈ vars_of (t ⊲ θ1)" unfolding σ
by auto
hence "v ∈ vars_of t"
proof
assume "v ∈ vars_of (N ⊲ θ1) ∪ vars_of (N' ⊲ θ1)"
with True show ?thesis by (auto dest:l)
next
assume "v ∈ vars_of (t ⊲ θ1)"
thus ?thesis by (rule l)
qed

thus ?thesis by auto
qed auto
qed
qed (auto split: if_split_asm)

text ‹The result of a unification is either the identity
substitution or it eliminates a variable from one of the terms:›

lemma unify_eliminates:
assumes "unify_dom (M, N)"
assumes "unify M N = Some σ"
shows "(∃v∈vars_of M ∪ vars_of N. elim σ v) ∨ σ ≐ []"
(is "?P M N σ")
using assms
proof (induct M N arbitrary:σ)
case 1 thus ?case by simp
next
case 2 thus ?case by simp
next
case (3 c v)
have no_occs: "¬ Var v ≺ Const c" by simp
with 3 have "σ = [(v, Const c)]" by simp
with occs_elim[OF no_occs]
show ?case by auto
next
case (4 M N v)
hence no_occs: "¬ Var v ≺ M ⋅ N" by auto
with 4 have "σ = [(v, M⋅N)]" by simp
with occs_elim[OF no_occs]
show ?case by auto
next
case (5 v M)
hence no_occs: "¬ Var v ≺ M" by auto
with 5 have "σ = [(v, M)]" by simp
with occs_elim[OF no_occs]
show ?case by auto
next
case (6 c d) thus ?case
by (cases "c = d") auto
next
case (7 M N M' N' σ)
then obtain θ1 θ2
where "unify M M' = Some θ1"
and "unify (N ⊲ θ1) (N' ⊲ θ1) = Some θ2"
and σ: "σ = θ1 ◊ θ2"
and ih1: "?P M M' θ1"
and ih2: "?P (N⊲θ1) (N'⊲θ1) θ2"
by (auto split:option.split_asm)

from ‹unify_dom (M ⋅ N, M' ⋅ N')›
have "unify_dom (M, M')"
by (rule accp_downward) (rule unify_rel.intros)
hence no_new_vars:
"⋀t. vars_of (t ⊲ θ1) ⊆ vars_of M ∪ vars_of M' ∪ vars_of t"
by (rule unify_vars) (rule ‹unify M M' = Some θ1›)

from ih2 show ?case
proof
assume "∃v∈vars_of (N ⊲ θ1) ∪ vars_of (N' ⊲ θ1). elim θ2 v"
then obtain v
where "v∈vars_of (N ⊲ θ1) ∪ vars_of (N' ⊲ θ1)"
and el: "elim θ2 v" by auto
with no_new_vars show ?thesis unfolding σ
by (auto simp:elim_def)
next
assume empty[simp]: "θ2 ≐ []"

have "σ ≐ (θ1 ◊ [])" unfolding σ
by (rule subst_cong) auto
also have "… ≐ θ1" by auto
finally have "σ ≐ θ1" .

from ih1 show ?thesis
proof
assume "∃v∈vars_of M ∪ vars_of M'. elim θ1 v"
with elim_eq[OF ‹σ ≐ θ1›]
show ?thesis by auto
next
note ‹σ ≐ θ1›
also assume "θ1 ≐ []"
finally show ?thesis ..
qed
qed
qed

declare unify.psimps[simp del]

subsection ‹Termination proof›

termination unify
proof
let ?R = "measures [λ(M,N). card (vars_of M ∪ vars_of N),
λ(M, N). size M]"
show "wf ?R" by simp

fix M N M' N' :: "'a trm"
show "((M, M'), (M ⋅ N, M' ⋅ N')) ∈ ?R" ― "Inner call"
by (rule measures_lesseq) (auto intro: card_mono)

fix θ                                   ― "Outer call"
assume inner: "unify_dom (M, M')"
"unify M M' = Some θ"

from unify_eliminates[OF inner]
show "((N ⊲ θ, N' ⊲ θ), (M ⋅ N, M' ⋅ N')) ∈?R"
proof
― ‹Either a variable is eliminated \ldots›
assume "(∃v∈vars_of M ∪ vars_of M'. elim θ v)"
then obtain v
where "elim θ v"
and "v∈vars_of M ∪ vars_of M'" by auto
with unify_vars[OF inner]
have "vars_of (N⊲θ) ∪ vars_of (N'⊲θ)
⊂ vars_of (M⋅N) ∪ vars_of (M'⋅N')"
by auto

thus ?thesis
by (auto intro!: measures_less intro: psubset_card_mono)
next
― ‹Or the substitution is empty›
assume "θ ≐ []"
hence "N ⊲ θ = N"
and "N' ⊲ θ = N'" by auto
thus ?thesis
by (auto intro!: measures_less intro: psubset_card_mono)
qed
qed

subsection ‹Unification returns a Most General Unifier›

lemma unify_computes_MGU:
"unify M N = Some σ ⟹ MGU σ M N"
proof (induct M N arbitrary: σ rule: unify.induct)
case (7 M N M' N' σ) ― "The interesting case"

then obtain θ1 θ2
where "unify M M' = Some θ1"
and "unify (N ⊲ θ1) (N' ⊲ θ1) = Some θ2"
and σ: "σ = θ1 ◊ θ2"
and MGU_inner: "MGU θ1 M M'"
and MGU_outer: "MGU θ2 (N ⊲ θ1) (N' ⊲ θ1)"
by (auto split:option.split_asm)

show ?case
proof
from MGU_inner and MGU_outer
have "M ⊲ θ1 = M' ⊲ θ1"
and "N ⊲ θ1 ⊲ θ2 = N' ⊲ θ1 ⊲ θ2"
unfolding MGU_def Unifier_def
by auto
thus "M ⋅ N ⊲ σ = M' ⋅ N' ⊲ σ" unfolding σ
by simp
next
fix σ' assume "M ⋅ N ⊲ σ' = M' ⋅ N' ⊲ σ'"
hence "M ⊲ σ' = M' ⊲ σ'"
and Ns: "N ⊲ σ' = N' ⊲ σ'" by auto

with MGU_inner obtain δ
where eqv: "σ' ≐ θ1 ◊ δ"
unfolding MGU_def Unifier_def
by auto

from Ns have "N ⊲ θ1 ⊲ δ = N' ⊲ θ1 ⊲ δ"

with MGU_outer obtain ρ
where eqv2: "δ ≐ θ2 ◊ ρ"
unfolding MGU_def Unifier_def
by auto

have "σ' ≐ σ ◊ ρ" unfolding σ
by (rule subst_eq_intro, auto simp:subst_eq_dest[OF eqv] subst_eq_dest[OF eqv2])
thus "∃γ. σ' ≐ σ ◊ γ" ..
qed
qed (auto simp: MGU_Const intro: MGU_Var MGU_Var[symmetric] split: if_split_asm)

subsection ‹Unification returns Idempotent Substitution›

definition Idem :: "'a subst ⇒ bool"
where "Idem s ⟷ (s ◊ s) ≐ s"

lemma Idem_Nil [iff]: "Idem []"

lemma Var_Idem:
assumes "~ (Var v ≺ t)" shows "Idem [(v,t)]"
unfolding Idem_def
proof
from assms have [simp]: "t ⊲ [(v, t)] = t"
by (metis assoc.simps(2) subst.simps(1) subst_no_occs)

fix s show "s ⊲ [(v, t)] ◊ [(v, t)] = s ⊲ [(v, t)]"
by (induct s) auto
qed

lemma Unifier_Idem_subst:
"Idem(r) ⟹ Unifier s (t ⊲ r) (u ⊲ r) ⟹
Unifier (r ◊ s) (t ⊲ r) (u ⊲ r)"
by (simp add: Idem_def Unifier_def subst_eq_def)

lemma Idem_comp:
"Idem r ⟹ Unifier s (t ⊲ r) (u ⊲ r) ⟹
(!!q. Unifier q (t ⊲ r) (u ⊲ r) ⟹ s ◊ q ≐ q) ⟹
Idem (r ◊ s)"
apply (frule Unifier_Idem_subst, blast)
apply (force simp add: Idem_def subst_eq_def)
done

theorem unify_gives_Idem:
"unify M N  = Some σ ⟹ Idem σ"
proof (induct M N arbitrary: σ rule: unify.induct)
case (7 M M' N N' σ)

then obtain θ1 θ2
where "unify M N = Some θ1"
and θ2: "unify (M' ⊲ θ1) (N' ⊲ θ1) = Some θ2"
and σ: "σ = θ1 ◊ θ2"
and "Idem θ1"
and "Idem θ2"
by (auto split: option.split_asm)

from θ2 have "Unifier θ2 (M' ⊲ θ1) (N' ⊲ θ1)"
by (rule unify_computes_MGU[THEN MGU_is_Unifier])

with ‹Idem θ1›
show "Idem σ" unfolding σ
proof (rule Idem_comp)
fix σ assume "Unifier σ (M' ⊲ θ1) (N' ⊲ θ1)"
with θ2 obtain γ where σ: "σ ≐ θ2 ◊ γ"
using unify_computes_MGU MGU_def by blast

have "θ2 ◊ σ ≐ θ2 ◊ (θ2 ◊ γ)" by (rule subst_cong) (auto simp: σ)
also have "... ≐ (θ2 ◊ θ2) ◊ γ" by (rule comp_assoc[symmetric])
also have "... ≐ θ2 ◊ γ" by (rule subst_cong) (auto simp: ‹Idem θ2›[unfolded Idem_def])
also have "... ≐ σ" by (rule σ[symmetric])
finally show "θ2 ◊ σ ≐ σ" .
qed
qed (auto intro!: Var_Idem split: option.splits if_splits)

end
```