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