diff -r ed54ec416bb3 -r 5c816239deaa Unification/Mgu.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Unification/Mgu.thy	Sun Apr 29 11:29:56 2012 +0100
@@ -0,0 +1,403 @@
+
+
+theory Mgu = Main + Terms + Fresh + Equ + Substs:
+
+(* unification problems *)
+
+syntax
+ "_equ_prob"   :: "trm \<Rightarrow> trm \<Rightarrow> (trm\<times>trm)"        ("_ \<approx>? _" [81,81] 81)
+ "_fresh_prob" :: "string \<Rightarrow> trm \<Rightarrow> (string\<times>trm)"  ("_ \<sharp>? _" [81,81] 81)
+
+translations 
+  "t1 \<approx>? t2" \<rightharpoonup> "(t1,t2)"
+  " a \<sharp>? t"  \<rightharpoonup> "(a,t)"
+
+(* all solutions for a unification problem *)
+
+types 
+  problem_type = "((trm\<times>trm)list) \<times> ((string\<times>trm)list)"
+  unifier_type = "fresh_envs \<times> substs"
+
+consts 
+  U :: "problem_type \<Rightarrow> (unifier_type set)"
+defs all_solutions_def : 
+  "U P  \<equiv> {(nabla,s). 
+             (\<forall> (t1,t2)\<in>set (fst P). nabla \<turnstile> subst s t1 \<approx> subst s t2) \<and> 
+             (\<forall>   (a,t)\<in>set (snd P). nabla \<turnstile> a \<sharp> subst s t) }"
+
+(* set of variables in unification problems *)
+
+consts
+  vars_fprobs :: "((string\<times>trm) list) \<Rightarrow> (string set)"
+  vars_eprobs :: "((trm\<times>trm)list) \<Rightarrow> (string set)"
+  vars_probs  :: "problem_type \<Rightarrow> nat"
+primrec
+  "vars_fprobs [] = {}"
+  "vars_fprobs (x#xs) = (vars_trm (snd x))\<union>(vars_fprobs xs)"
+primrec
+  "vars_eprobs [] = {}"
+  "vars_eprobs (x#xs) = (vars_trm (snd x))\<union>(vars_trm (fst x))\<union>(vars_eprobs xs)"
+defs
+  vars_probs_def: "vars_probs P \<equiv> card((vars_fprobs (snd P))\<union>(vars_eprobs (fst P)))"
+
+
+(* most general unifier *)
+
+consts 
+  mgu :: "problem_type \<Rightarrow> unifier_type \<Rightarrow> bool"
+defs mgu_def:
+  "mgu P unif \<equiv> 
+   \<forall> (nabla,s1)\<in> U P. (\<exists> s2. (nabla\<Turnstile>(subst s2) (fst unif)) \<and> 
+                              (nabla\<Turnstile>subst (s2 \<bullet>(snd unif)) \<approx> subst s1))"
+
+(* idempotency of a unifier *)
+
+consts 
+  idem :: "unifier_type \<Rightarrow> bool"
+defs 
+  idem_def: "idem unif \<equiv> (fst unif)\<Turnstile> subst ((snd unif)\<bullet>(snd unif)) \<approx> subst (snd unif)"
+
+(* application of a substitution to a problem *)
+
+consts 
+  apply_subst :: "substs \<Rightarrow> problem_type \<Rightarrow> problem_type"
+defs apply_subst_def: 
+  "apply_subst s P \<equiv> (map (\<lambda>(t1,t2). (subst s t1 \<approx>? subst s t2)) (fst P),
+                      map (\<lambda>(a,t).   (a \<sharp>? (subst s t)) ) (snd P))" 
+
+(* equality reductions *)
+
+consts 
+  s_red :: "(problem_type \<times> substs \<times> problem_type) set"
+syntax 
+  "_s_red" :: "problem_type \<Rightarrow> substs \<Rightarrow> problem_type \<Rightarrow> bool"  ("_ \<turnstile> _ \<leadsto> _ " [80,80,80] 80)
+translations "P1 \<turnstile>sigma\<leadsto> P2" \<rightleftharpoons> "(P1,sigma,P2)\<in>s_red"
+inductive s_red
+intros
+  unit_sred[intro!,dest!]:    "((Unit\<approx>?Unit)#xs,ys) \<turnstile>[]\<leadsto> (xs,ys)"
+  paar_sred[intro!,dest!]:    "((Paar t1 t2\<approx>?Paar s1 s2)#xs,ys) \<turnstile>[]\<leadsto> ((t1\<approx>?s1)#(t2\<approx>?s2)#xs,ys)"
+  func_sred[intro!,dest!]:    "((Func F t1\<approx>?Func F t2)#xs,ys) \<turnstile>[]\<leadsto> ((t1\<approx>?t2)#xs,ys)"
+  abst_aa_sred[intro!,dest!]: "((Abst a t1\<approx>?Abst a t2)#xs,ys) \<turnstile>[]\<leadsto> ((t1\<approx>?t2)#xs,ys)"
+  abst_ab_sred[intro!]: "a\<noteq>b\<Longrightarrow> 
+                       ((Abst a t1\<approx>?Abst b t2)#xs,ys) \<turnstile>[]\<leadsto> ((t1\<approx>?swap [(a,b)] t2)#xs,(a\<sharp>?t2)#ys)"
+  atom_sred[intro!,dest!]:    "((Atom a\<approx>?Atom a)#xs,ys) \<turnstile>[]\<leadsto> (xs,ys)"  
+  susp_sred[intro!,dest!]:    "((Susp pi1 X\<approx>?Susp pi2 X)#xs,ys) 
+                                \<turnstile>[]\<leadsto> (xs,(map (\<lambda>a. a\<sharp>? Susp [] X) (ds_list pi1 pi2))@ys)"
+  var_1_sred[intro!]:   "\<not>(occurs X t)\<Longrightarrow>((Susp pi X\<approx>?t)#xs,ys)
+                               \<turnstile>[(X,swap (rev pi) t)]\<leadsto> apply_subst [(X,swap (rev pi) t)] (xs,ys)"
+  var_2_sred[intro!]:   "\<not>(occurs X t)\<Longrightarrow>((t\<approx>?Susp pi X)#xs,ys) 
+                               \<turnstile>[(X,swap (rev pi) t)]\<leadsto> apply_subst [(X,swap (rev pi) t)] (xs,ys)"
+
+(* freshness reductions *)
+
+consts 
+  c_red :: "(problem_type \<times> fresh_envs \<times> problem_type) set"
+syntax 
+  "_c_red" :: "problem_type \<Rightarrow> fresh_envs \<Rightarrow> problem_type \<Rightarrow> bool" ("_ \<turnstile> _ \<rightarrow> _ " [80,80,80] 80)
+translations "P1 \<turnstile>nabla\<rightarrow> P2" \<rightleftharpoons> "(P1,nabla,P2)\<in>c_red"
+inductive c_red
+intros
+  unit_cred[intro!]:    "([],(a \<sharp>? Unit)#xs) \<turnstile>{}\<rightarrow> ([],xs)"
+  paar_cred[intro!]:    "([],(a \<sharp>? Paar t1 t2)#xs) \<turnstile>{}\<rightarrow> ([],(a\<sharp>?t1)#(a\<sharp>?t2)#xs)"
+  func_cred[intro!]:    "([],(a \<sharp>? Func F t)#xs) \<turnstile>{}\<rightarrow> ([],(a\<sharp>?t)#xs)"
+  abst_aa_cred[intro!]: "([],(a \<sharp>? Abst a t)#xs) \<turnstile>{}\<rightarrow> ([],xs)"
+  abst_ab_cred[intro!]: "a\<noteq>b\<Longrightarrow>([],(a \<sharp>? Abst b t)#xs) \<turnstile>{}\<rightarrow> ([],(a\<sharp>?t)#xs)"
+  atom_cred[intro!]:    "a\<noteq>b\<Longrightarrow>([],(a \<sharp>? Atom b)#xs) \<turnstile>{}\<rightarrow> ([],xs)"  
+  susp_cred[intro!]:    "([],(a \<sharp>? Susp pi X)#xs) \<turnstile>{((swapas (rev pi) a),X)}\<rightarrow> ([],xs)" 
+
+(* unification reduction sequence *)
+
+consts 
+  red_plus :: "(problem_type \<times> unifier_type \<times> problem_type) set"
+syntax 
+  red_plus :: "problem_type \<Rightarrow> unifier_type \<Rightarrow> problem_type \<Rightarrow> bool" ("_ \<Turnstile> _ \<Rightarrow> _ " [80,80,80] 80)
+
+translations "P1 \<Turnstile>(nabla,s)\<Rightarrow> P2" \<rightleftharpoons> "(P1,(nabla,s),P2)\<in>red_plus"
+inductive red_plus
+intros
+  sred_single[intro!]: "\<lbrakk>P1\<turnstile>s1\<leadsto>P2\<rbrakk>\<Longrightarrow>P1\<Turnstile>({},s1)\<Rightarrow>P2"
+  cred_single[intro!]: "\<lbrakk>P1\<turnstile>nabla1\<rightarrow>P2\<rbrakk>\<Longrightarrow>P1\<Turnstile>(nabla1,[])\<Rightarrow>P2"
+  sred_step[intro!]:   "\<lbrakk>P1\<turnstile>s1\<leadsto>P2;P2\<Turnstile>(nabla2,s2)\<Rightarrow>P3\<rbrakk>\<Longrightarrow>P1\<Turnstile>(nabla2,(s2\<bullet>s1))\<Rightarrow>P3"
+  cred_step[intro!]:   "\<lbrakk>P1\<turnstile>nabla1\<rightarrow>P2;P2\<Turnstile>(nabla2,[])\<Rightarrow>P3\<rbrakk>\<Longrightarrow>P1\<Turnstile>(nabla2\<union>nabla1,[])\<Rightarrow>P3"
+
+lemma mgu_idem: 
+  "\<lbrakk>(nabla1,s1)\<in>U P; 
+   \<forall>(nabla2,s2)\<in> U P. nabla2\<Turnstile>(subst s2) nabla1 \<and>  nabla2\<Turnstile>subst(s2 \<bullet> s1)\<approx>subst s2 \<rbrakk>\<Longrightarrow>
+   mgu P (nabla1,s1)\<and>idem (nabla1,s1)"
+apply(rule conjI)
+apply(simp only: mgu_def)
+apply(rule ballI)
+apply(simp)
+apply(drule_tac x="x" in bspec)
+apply(assumption)
+apply(force)
+apply(drule_tac x="(nabla1,s1)" in bspec)
+apply(assumption)
+apply(simp add: idem_def)
+done
+
+lemma problem_subst_comm: "((nabla,s2)\<in>U (apply_subst s1 P)) = ((nabla,(s2\<bullet>s1))\<in>U P)"
+apply(simp add: all_solutions_def apply_subst_def)
+apply(auto)
+apply(drule_tac x="(a,b)" in bspec, assumption, simp add: subst_comp_expand)+
+done
+
+lemma P1_to_P2_sred: 
+  "\<lbrakk>(nabla1,s1)\<in>U P1; P1 \<turnstile>s2\<leadsto> P2 \<rbrakk>\<Longrightarrow>((nabla1,s1)\<in>U P2) \<and> (nabla1\<Turnstile>subst (s1\<bullet>s2)\<approx>subst s1)"
+apply(ind_cases "P1 \<turnstile>s2\<leadsto> P2")
+apply(simp_all)
+--Unit
+apply(force intro!: equ_refl simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+--Paar
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+apply(force intro!: equ_refl dest!: equ_paar_elim)
+--Func
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+apply(force intro!: equ_refl dest!: equ_func_elim)
+--Abst.aa
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+apply(force intro!: equ_refl dest!: equ_abst_aa_elim)
+--Abst.ab
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+apply(force intro!: equ_refl dest!: equ_abst_ab_elim simp add: subst_swap_comm)
+--Atom
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def subst_susp)
+apply(force intro!: equ_refl)
+--Susp
+apply(rule conjI)
+apply(auto)
+apply(simp add: all_solutions_def)
+apply(erule conjE)+
+apply(simp add: ds_list_equ_ds)
+apply(simp only: subst_susp)
+apply(drule equ_pi1_pi2_dec[THEN mp])
+apply(auto)
+apply(drule_tac x="aa" in bspec)
+apply(assumption)
+apply(simp add: subst_susp)
+apply(simp add: subst_equ_def subst_susp)
+apply(rule ballI)
+apply(rule equ_refl)
+--Var.one
+apply(drule_tac "t2.1"="swap (rev pi) t" in subst_not_occurs[THEN mp])
+apply(simp only: problem_subst_comm)
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def)
+apply(rule conjI)
+apply(rule ballI)
+apply(erule conjE)+
+apply(drule unif_1)
+apply(clarify)
+apply(drule_tac x="(a,b)" in bspec)
+apply(assumption)
+apply(simp)
+apply(simp add: unif_2a)
+apply(erule conjE)+
+apply(drule unif_1)
+apply(rule ballI)
+apply(clarify)
+apply(drule_tac x="(a,b)" in bspec)
+apply(assumption)
+apply(simp)
+apply(simp add: unif_2b)
+apply(rule unif_1)
+apply(simp add: all_solutions_def)
+--Var.two
+apply(drule_tac "t2.1"="swap (rev pi) t" in subst_not_occurs[THEN mp])
+apply(simp only: problem_subst_comm)
+apply(simp add: all_solutions_def ext_subst_def subst_equ_def)
+apply(auto)
+apply(drule_tac x="(a,b)" in bspec)
+apply(assumption)
+apply(simp)
+apply(drule equ_sym)
+apply(drule unif_1)
+apply(simp add: unif_2a)
+apply(drule_tac x="(a,b)" in bspec)
+apply(assumption)
+apply(simp)
+apply(drule equ_sym)
+apply(drule unif_1)
+apply(simp add: unif_2b)
+apply(rule unif_1)
+apply(rule equ_sym)
+apply(simp add: all_solutions_def)
+done
+
+lemma P1_from_P2_sred: "\<lbrakk>(nabla1,s1)\<in>U P2; P1\<turnstile>s2\<leadsto>P2\<rbrakk>\<Longrightarrow>(nabla1,s1\<bullet>s2)\<in>U P1"
+apply(ind_cases "P1 \<turnstile>s2\<leadsto> P2")
+--Susp.Paar.Func.Abst.aa
+apply(simp add: all_solutions_def, force)
+apply(simp add: all_solutions_def, force)
+apply(simp add: all_solutions_def, force)
+apply(simp add: all_solutions_def, force)
+--Abst.ab
+apply(simp only: all_solutions_def)
+apply(force simp add: subst_swap_comm)
+--Atom
+apply(simp only: all_solutions_def, force)
+--Susp
+apply(simp)
+apply(auto)
+apply(simp add: all_solutions_def)
+apply(simp add: ds_list_equ_ds)
+apply(subgoal_tac "nabla1\<turnstile>(swap pi1 (subst s1 (Susp [] X)))\<approx>(swap pi2 (subst s1 (Susp [] X)))")
+apply(simp add: subst_susp subst_swap_comm)
+apply(simp add: subst_susp subst_swap_comm)
+apply(rule equ_pi1_pi2_add[THEN mp])
+apply(drule conjunct2)
+apply(auto)
+apply(drule_tac x="(a,Susp [] X)" in bspec)
+apply(auto)
+apply(simp add: subst_susp)
+--Var.one
+apply(simp only: problem_subst_comm)
+apply(simp only: all_solutions_def)
+apply(simp)
+apply(simp only: subst_comp_expand)
+apply(subgoal_tac "subst [(X, swap (rev pi) t)] t = t")--A
+apply(simp add: subst_susp)
+apply(simp only: subst_swap_comm)
+apply(simp only: equ_pi_to_right[THEN sym])
+apply(simp only: equ_involutive_right)
+apply(rule equ_refl)
+--A
+apply(rule subst_not_occurs[THEN mp])
+apply(assumption)
+--Var.two
+apply(simp only: problem_subst_comm)
+apply(simp only: all_solutions_def)
+apply(simp)
+apply(simp only: subst_comp_expand)
+apply(subgoal_tac "subst [(X, swap (rev pi) t)] t = t")--B
+apply(simp add: subst_susp)
+apply(simp only: subst_swap_comm)
+apply(simp only: equ_pi_to_left[THEN sym])
+apply(simp only: equ_involutive_left)
+apply(rule equ_refl)
+--B
+apply(rule subst_not_occurs[THEN mp])
+apply(assumption)
+done
+
+lemma P1_to_P2_cred: 
+  "\<lbrakk>(nabla1,s1)\<in>U P1; P1 \<turnstile>nabla2\<rightarrow> P2 \<rbrakk>\<Longrightarrow>((nabla1,s1)\<in>U P2) \<and> (nabla1\<Turnstile>(subst s1) nabla2)"
+apply(ind_cases " P1\<turnstile>nabla2\<rightarrow>P2")
+apply(simp_all)
+apply(auto simp add: ext_subst_def all_solutions_def)
+apply(rule fresh_swap_left[THEN mp])
+apply(simp add: subst_swap_comm[THEN sym] subst_susp)
+done
+
+lemma P1_from_P2_cred: 
+  "\<lbrakk>(nabla1,s1)\<in>U P2; P1 \<turnstile>nabla2\<rightarrow> P2; nabla3\<Turnstile>(subst s1) nabla2\<rbrakk>\<Longrightarrow>(nabla1\<union>nabla3,s1)\<in>U P1"
+apply(ind_cases "P1 \<turnstile>nabla2\<rightarrow> P2")
+apply(simp_all)
+apply(auto simp add: ext_subst_def all_solutions_def fresh_weak)
+apply(simp add: subst_susp)
+apply(rule fresh_swap_right[THEN mp])
+apply(drule_tac "nabla2.1"="nabla1" in fresh_weak[THEN mp])
+apply(subgoal_tac "nabla3 \<union> nabla1=nabla1 \<union> nabla3")--A
+apply(simp)
+apply(rule Un_commute)
+done
+
+lemma P1_to_P2_red_plus: "\<lbrakk>P1 \<Turnstile>(nabla,s)\<Rightarrow>P2\<rbrakk>\<Longrightarrow> (nabla1,s1)\<in>U P1 \<longrightarrow>
+  ((nabla1,s1)\<in>U P2)\<and>(nabla1\<Turnstile>subst (s1\<bullet>s)\<approx>subst s1)\<and>(nabla1\<Turnstile>(subst s1) nabla)"
+apply(erule red_plus.induct)
+-- sred
+apply(rule impI)
+apply(drule_tac "P2.0"="P2" and "s2.0"="s1a" in P1_to_P2_sred)
+apply(force)
+apply(rule conjI, force)+
+apply(force simp add: ext_subst_def)
+-- cred
+apply(rule impI)
+apply(drule_tac "P2.0"="P2" and "nabla2.0"="nabla1a" in P1_to_P2_cred)
+apply(assumption)
+apply(force intro!: equ_refl simp add: subst_equ_def)
+-- sred
+apply(rule impI)
+apply(drule_tac "P2.0"="P2" and "s2.0"="s1a" in P1_to_P2_sred)
+apply(assumption)
+apply(erule conjE)+
+apply(rule conjI)
+apply(force)
+apply(rule conjI)
+apply(drule mp)
+apply(assumption)
+apply(erule conjE)+
+apply(rule_tac "s2.0"="((s1\<bullet>s2)\<bullet>s1a)" in subst_trans)
+apply(simp only: subst_assoc subst_equ_def)
+apply(rule ballI)
+apply(rule equ_refl)
+apply(rule_tac "s2.0"="(s1\<bullet>s1a)" in subst_trans)
+apply(rule subst_cancel_right)
+apply(assumption)
+apply(assumption)
+apply(force)
+-- cred
+apply(rule impI)
+apply(drule_tac "P2.0"="P2" and "nabla2.0"="nabla1a" in P1_to_P2_cred)
+apply(auto simp add: ext_subst_def)
+done
+
+lemma P1_from_P2_red_plus: "\<lbrakk>P1 \<Turnstile>(nabla,s)\<Rightarrow>P2\<rbrakk>\<Longrightarrow>(nabla1,s1)\<in>U P2\<longrightarrow>
+        nabla3\<Turnstile>(subst s1)(nabla)\<longrightarrow>(nabla1\<union>nabla3,(s1\<bullet>s))\<in>U P1"
+apply(erule red_plus.induct)
+-- sred
+apply(rule impI)+
+apply(drule_tac "P1.0"="P1" and "s2.0"="s1a" in P1_from_P2_sred)
+apply(assumption)
+apply(force simp only: all_solutions_def equ_weak fresh_weak)
+-- cred
+apply(rule impI)+
+apply(drule_tac "P1.0"="P1" and "nabla3.0"="nabla3" and "nabla2.0"="nabla1a" in P1_from_P2_cred)
+apply(assumption)+
+apply(simp add: all_solutions_def)
+-- sred
+apply(rule impI)+
+apply(simp)
+apply(drule_tac "P1.0"="P1" and "P2.0"="P2" and "s2.0"="s1a" in P1_from_P2_sred)
+apply(assumption)
+apply(simp add: all_solutions_def subst_assoc)
+-- cred
+apply(rule impI)+
+apply(subgoal_tac "nabla3 \<Turnstile> (subst s1) nabla2")--A
+apply(simp)
+apply(drule_tac "P1.0"="P1" and "P2.0"="P2" and
+                "nabla2.0"="nabla1a" and "nabla3.0"="nabla3" in P1_from_P2_cred)
+apply(assumption)
+apply(simp)
+apply(simp add: ext_subst_def)
+apply(subgoal_tac "nabla1 \<union> nabla3 \<union> nabla3=nabla1 \<union> nabla3")--A
+apply(simp)
+--A
+apply(force)
+--B
+apply(simp add: ext_subst_def)
+done
+
+lemma mgu: "\<lbrakk>P \<Turnstile>(nabla,s)\<Rightarrow>([],[])\<rbrakk>\<Longrightarrow> mgu P (nabla,s) \<and> idem (nabla,s)"
+apply(frule_tac "nabla3.2"="nabla" and "nabla2"="nabla" and 
+                "s1.2"="[]" and "nabla1.2"="{}"
+                in P1_from_P2_red_plus[THEN mp,THEN mp])
+apply(force simp add: all_solutions_def)
+apply(force simp add: ext_subst_def)
+apply(rule mgu_idem)
+apply(simp add: all_solutions_def)
+apply(rule ballI)
+apply(clarify)
+apply(drule_tac  "nabla1.0"="a" and "s1.0"="b"in P1_to_P2_red_plus)
+apply(simp)
+done  
+
+end
+
+
+
+
+
+
+
+
+