diff -r ed54ec416bb3 -r 5c816239deaa Unification/Termination.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Unification/Termination.thy	Sun Apr 29 11:29:56 2012 +0100
@@ -0,0 +1,205 @@
+
+
+theory Termination = Main + Terms + Fresh + Equ + Substs + Mgu:
+
+(* set of variables *)
+
+consts 
+  vars_trm    :: "trm \<Rightarrow> string set"
+  vars_eprobs :: "eprobs \<Rightarrow> (string set)"
+primrec
+  "vars_trm (Unit)       = {}"
+  "vars_trm (Atom a)     = {}"
+  "vars_trm (Susp pi X)  = {X}"
+  "vars_trm (Paar t1 t2) = (vars_trm t1)\<union>(vars_trm t2)"
+  "vars_trm (Abst a t)   = vars_trm t"
+  "vars_trm (Func F t)   = vars_trm t"
+primrec
+  "vars_eprobs [] = {}"
+  "vars_eprobs (x#xs) = (vars_trm (snd x))\<union>(vars_trm (fst x))\<union>(vars_eprobs xs)"
+
+lemma[simp]: "vars_trm (swap pi t) = vars_trm t"
+apply(induct_tac t)
+apply(auto)
+done
+
+consts 
+  size_trm    :: "trm \<Rightarrow> nat"
+  size_fprobs :: "fprobs \<Rightarrow> nat"
+  size_eprobs :: "eprobs \<Rightarrow> nat"
+  size_probs  :: "probs \<Rightarrow> nat"
+primrec
+  "size_trm (Unit)      = 1"
+  "size_trm (Atom a)    = 1"
+  "size_trm (Susp pi X) = 1"
+  "size_trm (Abst a t)  = 1 + size_trm t"
+  "size_trm (Func F t)  = 1 + size_trm t"
+  "size_trm (Paar t t') = 1 + (size_trm t) + (size_trm t')"
+primrec
+  "size_fprobs [] = 0"
+  "size_fprobs (x#xs) = (size_trm (snd x))+(size_fprobs xs)"
+primrec
+  "size_eprobs [] = 0"
+  "size_eprobs (x#xs) = (size_trm (fst x))+(size_trm (snd x))+(size_eprobs xs)"
+
+lemma[simp]: "size_trm (swap pi t) = size_trm t"
+apply(induct_tac t)
+apply(auto)
+done
+
+syntax        
+  "_measure_relation" :: "(nat\<times>nat\<times>nat) \<Rightarrow> (nat\<times>nat\<times>nat) \<Rightarrow> bool" ("_ \<lless> _" [80,80] 80)
+translations
+  "n1 \<lless> n2"  \<rightleftharpoons> "(n1,n2) \<in> (less_than<*lex*>less_than<*lex*>less_than)"
+
+consts 
+  rank :: "probs \<Rightarrow> (nat\<times>nat\<times>nat)"
+primrec
+  "rank (eprobs,fprobs) = (card (vars_eprobs eprobs),size_eprobs eprobs,size_fprobs fprobs)" 
+
+lemma[simp]: "finite (vars_trm t)"
+apply(induct t)
+apply(auto)
+done
+
+lemma[simp]: "finite (vars_eprobs P)"
+apply(induct_tac P)
+apply(auto)
+done
+
+lemma union_comm: "A\<union>(B\<union>C)=(A\<union>B)\<union>C"
+apply(auto)
+done
+
+lemma card_union: "\<lbrakk>finite A; finite B\<rbrakk>\<Longrightarrow>(card B < card (A\<union>B)) \<or> (card B = card (A\<union>B))"
+apply(auto)
+apply(rule psubset_card_mono)
+apply(auto)
+done
+
+lemma card_insert: "\<lbrakk>finite B\<rbrakk>\<Longrightarrow>(card B < card (insert X B)) \<or> (card B = card (insert X B))"
+apply(auto)
+apply(rule psubset_card_mono)
+apply(auto)
+done
+
+lemma subseteq_card: "\<lbrakk>A\<subseteq>B; finite B\<rbrakk>\<Longrightarrow>(card A \<le> card B)"
+apply(drule_tac A="A" in card_mono)
+apply(auto simp add: le_eq_less_or_eq)
+done
+
+lemma not_occurs_trm: "\<not>occurs X t \<longrightarrow> X\<notin> vars_trm t"
+apply(induct_tac t)
+apply(auto)
+done
+
+lemma not_occurs_subst: "\<not>occurs X t1\<longrightarrow> X\<notin> vars_trm (subst [(X,swap pi2 t1)] t2)" 
+apply(induct_tac t2)
+apply(auto simp add: subst_susp not_occurs_trm)
+done
+
+lemma not_occurs_list: "\<not>occurs X t \<longrightarrow>
+  X\<notin> vars_eprobs (apply_subst_eprobs [(X, swap pi t)] xs)"
+apply(induct_tac xs)
+apply(simp)
+apply(case_tac a)
+apply(auto simp add: not_occurs_subst)
+done
+
+lemma vars_equ: "\<not>occurs X t1 \<and> occurs X t2\<longrightarrow> 
+  vars_trm (subst [(X, swap pi t1)] t2)=(vars_trm t1\<union>vars_trm t2)-{X}"
+apply(induct_tac t2)
+apply(force)
+apply(case_tac "X=list2")
+apply(simp add: subst_susp not_occurs_trm)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(rule conjI)
+apply(case_tac "occurs X trm2")
+apply(force)
+apply(force dest: not_occurs_trm[THEN mp] simp add: subst_not_occurs)
+apply(force dest: not_occurs_trm[THEN mp] simp add: subst_not_occurs)
+apply(force)
+done
+
+lemma vars_subseteq: "\<not>occurs X t \<longrightarrow>
+  vars_eprobs (apply_subst_eprobs [(X, swap pi t)] xs) \<subseteq> (vars_trm t \<union> vars_eprobs xs)"
+apply(induct_tac xs)
+apply(simp)
+apply(rule impI)
+apply(simp)
+apply(case_tac "occurs X (fst a)")
+apply(case_tac "occurs X (snd a)")
+apply(simp add: vars_equ[THEN mp])
+apply(force)
+apply(simp add: subst_not_occurs)
+apply(force simp add: vars_equ)
+apply(case_tac "occurs X (snd a)")
+apply(simp add: vars_equ[THEN mp])
+apply(force simp add: subst_not_occurs)
+apply(force simp add: subst_not_occurs)
+done
+
+lemma vars_decrease: 
+  "\<not>occurs X t\<longrightarrow> card (vars_eprobs (apply_subst_eprobs [(X, swap pi t)] xs))
+                 <card (insert X (vars_trm t \<union> vars_eprobs xs))"
+apply(rule impI)
+apply(case_tac "X\<in>(vars_trm t \<union> vars_eprobs xs)")
+(* first case *)
+apply(subgoal_tac "insert X (vars_trm t \<union> vars_eprobs xs) = (vars_trm t \<union> vars_eprobs xs)") (*A*)
+apply(simp)
+apply(frule_tac pi1="pi" and xs1="xs" in vars_subseteq[THEN mp])
+apply(frule_tac pi1="pi" and xs1="xs" in not_occurs_list[THEN mp])
+apply(subgoal_tac "vars_eprobs (apply_subst_eprobs [(X, swap pi t)] xs)
+                   \<subset>  vars_trm t \<union> vars_eprobs xs") (* B *)
+apply(simp add: psubset_card_mono)
+(* B *)
+apply(force)
+(* A *)
+apply(force)
+(* second case *)
+apply(subgoal_tac "finite (vars_trm t \<union> vars_eprobs xs)")
+apply(drule_tac x="X" in card_insert_disjoint)
+apply(simp)
+apply(simp)
+apply(frule_tac pi1="pi" and xs1="xs" in vars_subseteq[THEN mp])
+apply(auto dest: subseteq_card)
+done
+
+lemma rank_cred: "\<lbrakk>P1\<turnstile>(nabla)\<rightarrow>P2\<rbrakk>\<Longrightarrow>(rank P2) \<lless> (rank P1)"
+apply(ind_cases "P1 \<turnstile> nabla \<rightarrow> P2")
+apply(simp_all add: lex_prod_def)
+done
+
+lemma rank_sred: "\<lbrakk>P1\<turnstile>(s)\<leadsto>P2\<rbrakk>\<Longrightarrow>(rank P2) \<lless> (rank P1)"
+apply(ind_cases "P1 \<turnstile> s \<leadsto> P2")
+apply(simp_all add: lex_prod_def union_comm)
+apply(subgoal_tac 
+  "vars_trm s1\<union>vars_trm t1\<union>vars_trm s2\<union>vars_trm t2\<union>vars_eprobs xs = 
+   vars_trm s1\<union>vars_trm s2\<union>vars_trm t1\<union>vars_trm t2\<union>vars_eprobs xs") (*A*)
+apply(simp)
+(* A *)
+apply(force)
+(* Susp-Susp case *)
+apply(simp add: card_insert)
+(* variable elimination cases *)
+apply(simp_all add: apply_subst_def vars_decrease)
+done
+
+
+lemma rank_trans: "\<lbrakk>rank P1 \<lless> rank P2; rank P2 \<lless> rank P3\<rbrakk>\<Longrightarrow>rank P1 \<lless> rank P3"
+apply(simp add: lex_prod_def)
+apply(auto)
+done
+
+(* all reduction are well-founded under \<lless> *)
+
+lemma rank_red_plus: "\<lbrakk>P1\<Turnstile>(s,nabla)\<Rightarrow>P2\<rbrakk>\<Longrightarrow>(rank P2) \<lless> (rank P1)"
+apply(erule red_plus.induct)
+apply(auto dest: rank_sred rank_cred rank_trans)
+done
+
+end
+