diff -r f0a6d971ebac -r ed37e4d67c65 Attic/Quot/Examples/LamEx.thy
--- a/Attic/Quot/Examples/LamEx.thy	Thu Apr 29 17:03:59 2010 +0200
+++ b/Attic/Quot/Examples/LamEx.thy	Thu Apr 29 17:16:35 2010 +0200
@@ -55,16 +55,16 @@
 lemma rfv_eqvt[eqvt]:
   fixes pi::"name prm"
   shows "(pi\<bullet>rfv t) = rfv (pi\<bullet>t)"
-apply(induct t)
-apply(simp_all)
-apply(simp add: perm_set_eq)
-apply(simp add: union_eqvt)
-apply(simp add: set_diff_eqvt)
-apply(simp add: perm_set_eq)
-done
+  apply(induct t)
+  apply(simp_all)
+  apply(simp add: perm_set_eq)
+  apply(simp add: union_eqvt)
+  apply(simp add: set_diff_eqvt)
+  apply(simp add: perm_set_eq)
+  done
 
 inductive
-    alpha :: "rlam \<Rightarrow> rlam \<Rightarrow> bool" ("_ \<approx> _" [100, 100] 100)
+  alpha :: "rlam \<Rightarrow> rlam \<Rightarrow> bool" ("_ \<approx> _" [100, 100] 100)
 where
   a1: "a = b \<Longrightarrow> (rVar a) \<approx> (rVar b)"
 | a2: "\<lbrakk>t1 \<approx> t2; s1 \<approx> s2\<rbrakk> \<Longrightarrow> rApp t1 s1 \<approx> rApp t2 s2"
@@ -76,101 +76,101 @@
 lemma alpha_eqvt:
   fixes pi::"name prm"
   shows "t \<approx> s \<Longrightarrow> (pi \<bullet> t) \<approx> (pi \<bullet> s)"
-apply(induct rule: alpha.induct)
-apply(simp add: a1)
-apply(simp add: a2)
-apply(simp)
-apply(rule a3)
-apply(erule conjE)
-apply(erule exE)
-apply(erule conjE)
-apply(rule_tac x="pi \<bullet> pia" in exI)
-apply(rule conjI)
-apply(rule_tac pi1="rev pi" in perm_bij[THEN iffD1])
-apply(perm_simp add: eqvts)
-apply(rule conjI)
-apply(rule_tac pi1="rev pi" in pt_fresh_star_bij(1)[OF pt_name_inst at_name_inst, THEN iffD1])
-apply(perm_simp add: eqvts)
-apply(rule conjI)
-apply(subst perm_compose[symmetric])
-apply(simp)
-apply(subst perm_compose[symmetric])
-apply(simp)
-done
+  apply(induct rule: alpha.induct)
+  apply(simp add: a1)
+  apply(simp add: a2)
+  apply(simp)
+  apply(rule a3)
+  apply(erule conjE)
+  apply(erule exE)
+  apply(erule conjE)
+  apply(rule_tac x="pi \<bullet> pia" in exI)
+  apply(rule conjI)
+  apply(rule_tac pi1="rev pi" in perm_bij[THEN iffD1])
+  apply(perm_simp add: eqvts)
+  apply(rule conjI)
+  apply(rule_tac pi1="rev pi" in pt_fresh_star_bij(1)[OF pt_name_inst at_name_inst, THEN iffD1])
+  apply(perm_simp add: eqvts)
+  apply(rule conjI)
+  apply(subst perm_compose[symmetric])
+  apply(simp)
+  apply(subst perm_compose[symmetric])
+  apply(simp)
+  done
 
 lemma alpha_refl:
   shows "t \<approx> t"
-apply(induct t rule: rlam.induct)
-apply(simp add: a1)
-apply(simp add: a2)
-apply(rule a3)
-apply(rule_tac x="[]" in exI)
-apply(simp_all add: fresh_star_def fresh_list_nil)
-done
+  apply(induct t rule: rlam.induct)
+  apply(simp add: a1)
+  apply(simp add: a2)
+  apply(rule a3)
+  apply(rule_tac x="[]" in exI)
+  apply(simp_all add: fresh_star_def fresh_list_nil)
+  done
 
 lemma alpha_sym:
   shows "t \<approx> s \<Longrightarrow> s \<approx> t"
-apply(induct rule: alpha.induct)
-apply(simp add: a1)
-apply(simp add: a2)
-apply(rule a3)
-apply(erule exE)
-apply(rule_tac x="rev pi" in exI)
-apply(simp)
-apply(simp add: fresh_star_def fresh_list_rev)
-apply(rule conjI)
-apply(erule conjE)+
-apply(rotate_tac 3)
-apply(drule_tac pi="rev pi" in alpha_eqvt)
-apply(perm_simp)
-apply(rule pt_bij2[OF pt_name_inst at_name_inst])
-apply(simp)
-done
+  apply(induct rule: alpha.induct)
+  apply(simp add: a1)
+  apply(simp add: a2)
+  apply(rule a3)
+  apply(erule exE)
+  apply(rule_tac x="rev pi" in exI)
+  apply(simp)
+  apply(simp add: fresh_star_def fresh_list_rev)
+  apply(rule conjI)
+  apply(erule conjE)+
+  apply(rotate_tac 3)
+  apply(drule_tac pi="rev pi" in alpha_eqvt)
+  apply(perm_simp)
+  apply(rule pt_bij2[OF pt_name_inst at_name_inst])
+  apply(simp)
+  done
 
 lemma alpha_trans:
   shows "t1 \<approx> t2 \<Longrightarrow> t2 \<approx> t3 \<Longrightarrow> t1 \<approx> t3"
-apply(induct arbitrary: t3 rule: alpha.induct)
-apply(erule alpha.cases)
-apply(simp_all)
-apply(simp add: a1)
-apply(rotate_tac 4)
-apply(erule alpha.cases)
-apply(simp_all)
-apply(simp add: a2)
-apply(rotate_tac 1)
-apply(erule alpha.cases)
-apply(simp_all)
-apply(erule conjE)+
-apply(erule exE)+
-apply(erule conjE)+
-apply(rule a3)
-apply(rule_tac x="pia @ pi" in exI)
-apply(simp add: fresh_star_def fresh_list_append)
-apply(simp add: pt_name2)
-apply(drule_tac x="rev pia \<bullet> sa" in spec)
-apply(drule mp)
-apply(rotate_tac 8)
-apply(drule_tac pi="rev pia" in alpha_eqvt)
-apply(perm_simp)
-apply(rotate_tac 11)
-apply(drule_tac pi="pia" in alpha_eqvt)
-apply(perm_simp)
-done
+  apply(induct arbitrary: t3 rule: alpha.induct)
+  apply(erule alpha.cases)
+  apply(simp_all)
+  apply(simp add: a1)
+  apply(rotate_tac 4)
+  apply(erule alpha.cases)
+  apply(simp_all)
+  apply(simp add: a2)
+  apply(rotate_tac 1)
+  apply(erule alpha.cases)
+  apply(simp_all)
+  apply(erule conjE)+
+  apply(erule exE)+
+  apply(erule conjE)+
+  apply(rule a3)
+  apply(rule_tac x="pia @ pi" in exI)
+  apply(simp add: fresh_star_def fresh_list_append)
+  apply(simp add: pt_name2)
+  apply(drule_tac x="rev pia \<bullet> sa" in spec)
+  apply(drule mp)
+  apply(rotate_tac 8)
+  apply(drule_tac pi="rev pia" in alpha_eqvt)
+  apply(perm_simp)
+  apply(rotate_tac 11)
+  apply(drule_tac pi="pia" in alpha_eqvt)
+  apply(perm_simp)
+  done
 
 lemma alpha_equivp:
   shows "equivp alpha"
-apply(rule equivpI)
-unfolding reflp_def symp_def transp_def
-apply(auto intro: alpha_refl alpha_sym alpha_trans)
-done
+  apply(rule equivpI)
+  unfolding reflp_def symp_def transp_def
+  apply(auto intro: alpha_refl alpha_sym alpha_trans)
+  done
 
 lemma alpha_rfv:
   shows "t \<approx> s \<Longrightarrow> rfv t = rfv s"
-apply(induct rule: alpha.induct)
-apply(simp)
-apply(simp)
-apply(simp)
-done
+  apply(induct rule: alpha.induct)
+  apply(simp)
+  apply(simp)
+  apply(simp)
+  done
 
 quotient_type lam = rlam / alpha
   by (rule alpha_equivp)
@@ -210,16 +210,10 @@
 end
 
 lemma perm_rsp[quot_respect]:
-  "(op = ===> alpha ===> alpha) op \<bullet> op \<bullet>"
-  apply(auto)
-  (* this is propably true if some type conditions are imposed ;o) *)
-  sorry
-
-lemma fresh_rsp:
-  "(op = ===> alpha ===> op =) fresh fresh"
-  apply(auto)
-  (* this is probably only true if some type conditions are imposed *)
-  sorry
+  "(op = ===> alpha ===> alpha) op \<bullet> (op \<bullet> :: (name \<times> name) list \<Rightarrow> rlam \<Rightarrow> rlam)"
+  apply auto
+  apply(erule alpha_eqvt)
+  done
 
 lemma rVar_rsp[quot_respect]:
   "(op = ===> alpha) rVar rVar"
@@ -239,8 +233,8 @@
 
 lemma rfv_rsp[quot_respect]: 
   "(alpha ===> op =) rfv rfv"
-apply(simp add: alpha_rfv)
-done
+  apply(simp add: alpha_rfv)
+  done
 
 section {* lifted theorems *}
 
@@ -251,56 +245,47 @@
     \<Longrightarrow> P lam"
   by (lifting rlam.induct)
 
-ML {* show_all_types := true *}
-
 lemma perm_lam [simp]:
-  fixes pi::"'a prm"
+  fixes pi::"name prm"
   shows "pi \<bullet> Var a = Var (pi \<bullet> a)"
   and   "pi \<bullet> App t1 t2 = App (pi \<bullet> t1) (pi \<bullet> t2)"
   and   "pi \<bullet> Lam a t = Lam (pi \<bullet> a) (pi \<bullet> t)"
-apply(lifting perm_rlam.simps)
-ML_prf {*
-  List.last (map (symmetric o #def) (Quotient_Info.qconsts_dest @{context}));
-  List.last (map (Thm.varifyT o symmetric o #def) (Quotient_Info.qconsts_dest @{context}))
-*}
-done
+  by (lifting perm_rlam.simps[where 'a="name"])
 
 instance lam::pt_name
-apply(default)
-apply(induct_tac [!] x rule: lam_induct)
-apply(simp_all add: pt_name2 pt_name3)
-done
+  apply(default)
+  apply(induct_tac [!] x rule: lam_induct)
+  apply(simp_all add: pt_name2 pt_name3)
+  done
 
 lemma fv_lam [simp]: 
   shows "fv (Var a) = {a}"
   and   "fv (App t1 t2) = fv t1 \<union> fv t2"
   and   "fv (Lam a t) = fv t - {a}"
-apply(lifting rfv_var rfv_app rfv_lam)
-done
+  by(lifting rfv_var rfv_app rfv_lam)
 
-
-lemma a1: 
+lemma a1:
   "a = b \<Longrightarrow> Var a = Var b"
   by  (lifting a1)
 
-lemma a2: 
+lemma a2:
   "\<lbrakk>x = xa; xb = xc\<rbrakk> \<Longrightarrow> App x xb = App xa xc"
   by  (lifting a2)
 
-lemma a3: 
+lemma a3:
   "\<lbrakk>\<exists>pi::name prm. (fv t - {a} = fv s - {b} \<and> (fv t - {a})\<sharp>* pi \<and> (pi \<bullet> t) = s \<and> (pi \<bullet> a) = b)\<rbrakk> 
    \<Longrightarrow> Lam a t = Lam b s"
   by  (lifting a3)
 
-lemma alpha_cases: 
+lemma alpha_cases:
   "\<lbrakk>a1 = a2; \<And>a b. \<lbrakk>a1 = Var a; a2 = Var b; a = b\<rbrakk> \<Longrightarrow> P;
     \<And>x xa xb xc. \<lbrakk>a1 = App x xb; a2 = App xa xc; x = xa; xb = xc\<rbrakk> \<Longrightarrow> P;
-    \<And>t a s b. \<lbrakk>a1 = Lam a t; a2 = Lam b s; 
+    \<And>t a s b. \<lbrakk>a1 = Lam a t; a2 = Lam b s;
          \<exists>pi::name prm. fv t - {a} = fv s - {b} \<and> (fv t - {a}) \<sharp>* pi \<and> (pi \<bullet> t) = s \<and> pi \<bullet> a = b\<rbrakk> \<Longrightarrow> P\<rbrakk>
     \<Longrightarrow> P"
   by (lifting alpha.cases)
 
-lemma alpha_induct: 
+lemma alpha_induct:
   "\<lbrakk>qx = qxa; \<And>a b. a = b \<Longrightarrow> qxb (Var a) (Var b);
     \<And>x xa xb xc. \<lbrakk>x = xa; qxb x xa; xb = xc; qxb xb xc\<rbrakk> \<Longrightarrow> qxb (App x xb) (App xa xc);
      \<And>t a s b.
@@ -312,18 +297,18 @@
 lemma lam_inject [simp]: 
   shows "(Var a = Var b) = (a = b)"
   and   "(App t1 t2 = App s1 s2) = (t1 = s1 \<and> t2 = s2)"
-apply(lifting rlam.inject(1) rlam.inject(2))
-apply(auto)
-apply(drule alpha.cases)
-apply(simp_all)
-apply(simp add: alpha.a1)
-apply(drule alpha.cases)
-apply(simp_all)
-apply(drule alpha.cases)
-apply(simp_all)
-apply(rule alpha.a2)
-apply(simp_all)
-done
+  apply(lifting rlam.inject(1) rlam.inject(2))
+  apply(auto)
+  apply(drule alpha.cases)
+  apply(simp_all)
+  apply(simp add: alpha.a1)
+  apply(drule alpha.cases)
+  apply(simp_all)
+  apply(drule alpha.cases)
+  apply(simp_all)
+  apply(rule alpha.a2)
+  apply(simp_all)
+  done
 
 lemma rlam_distinct:
   shows "\<not>(rVar nam \<approx> rApp rlam1' rlam2')"
@@ -332,20 +317,20 @@
   and   "\<not>(rLam nam' rlam' \<approx> rVar nam)"
   and   "\<not>(rApp rlam1 rlam2 \<approx> rLam nam' rlam')"
   and   "\<not>(rLam nam' rlam' \<approx> rApp rlam1 rlam2)"
-apply auto
-apply(erule alpha.cases)
-apply simp_all
-apply(erule alpha.cases)
-apply simp_all
-apply(erule alpha.cases)
-apply simp_all
-apply(erule alpha.cases)
-apply simp_all
-apply(erule alpha.cases)
-apply simp_all
-apply(erule alpha.cases)
-apply simp_all
-done
+  apply auto
+  apply(erule alpha.cases)
+  apply simp_all
+  apply(erule alpha.cases)
+  apply simp_all
+  apply(erule alpha.cases)
+  apply simp_all
+  apply(erule alpha.cases)
+  apply simp_all
+  apply(erule alpha.cases)
+  apply simp_all
+  apply(erule alpha.cases)
+  apply simp_all
+  done
 
 lemma lam_distinct[simp]:
   shows "Var nam \<noteq> App lam1' lam2'"
@@ -354,8 +339,7 @@
   and   "Lam nam' lam' \<noteq> Var nam"
   and   "App lam1 lam2 \<noteq> Lam nam' lam'"
   and   "Lam nam' lam' \<noteq> App lam1 lam2"
-apply(lifting rlam_distinct(1) rlam_distinct(2) rlam_distinct(3) rlam_distinct(4) rlam_distinct(5) rlam_distinct(6))
-done
+  by(lifting rlam_distinct(1) rlam_distinct(2) rlam_distinct(3) rlam_distinct(4) rlam_distinct(5) rlam_distinct(6))
 
 lemma var_supp1:
   shows "(supp (Var a)) = ((supp a)::name set)"
@@ -367,31 +351,30 @@
 
 lemma app_supp:
   shows "supp (App t1 t2) = (supp t1) \<union> ((supp t2)::name set)"
-apply(simp only: perm_lam supp_def lam_inject)
-apply(simp add: Collect_imp_eq Collect_neg_eq)
-done
+  apply(simp only: perm_lam supp_def lam_inject)
+  apply(simp add: Collect_imp_eq Collect_neg_eq)
+  done
 
 lemma lam_supp:
   shows "supp (Lam x t) = ((supp ([x].t))::name set)"
-apply(simp add: supp_def)
-apply(simp add: abs_perm)
-sorry
-
+  apply(simp add: supp_def)
+  apply(simp add: abs_perm)
+  sorry
 
 instance lam::fs_name
-apply(default)
-apply(induct_tac x rule: lam_induct)
-apply(simp add: var_supp)
-apply(simp add: app_supp)
-apply(simp add: lam_supp abs_supp)
-done
+  apply(default)
+  apply(induct_tac x rule: lam_induct)
+  apply(simp add: var_supp)
+  apply(simp add: app_supp)
+  apply(simp add: lam_supp abs_supp)
+  done
 
 lemma fresh_lam:
   "(a \<sharp> Lam b t) \<longleftrightarrow> (a = b) \<or> (a \<noteq> b \<and> a \<sharp> t)"
-apply(simp add: fresh_def)
-apply(simp add: lam_supp abs_supp)
-apply(auto)
-done
+  apply(simp add: fresh_def)
+  apply(simp add: lam_supp abs_supp)
+  apply(auto)
+  done
 
 lemma lam_induct_strong:
   fixes a::"'a::fs_name"