# HG changeset patch
# User Christian Urban <christian dot urban at kcl dot ac dot uk>
# Date 1370335163 -3600
# Node ID e5d9b6bca88cde81be52cf7029773cde3c2522f4
# Parent  89158f401b070ceb606314bbe7a74c88541ffa00
updated to new Isabelle

diff -r 89158f401b07 -r e5d9b6bca88c Nominal/Ex/Lambda.thy
--- a/Nominal/Ex/Lambda.thy	Fri Apr 19 00:10:52 2013 +0100
+++ b/Nominal/Ex/Lambda.thy	Tue Jun 04 09:39:23 2013 +0100
@@ -4,6 +4,11 @@
   "~~/src/HOL/Library/Monad_Syntax"
 begin
 
+lemma perm_commute: 
+  "a \<sharp> p \<Longrightarrow> a' \<sharp> p \<Longrightarrow> (a \<rightleftharpoons> a') + p = p + (a \<rightleftharpoons> a')"
+apply(rule plus_perm_eq)
+apply(simp add: supp_swap fresh_def)
+done
 
 atom_decl name
 
@@ -14,6 +19,8 @@
 | App "lam" "lam"
 | Lam x::"name" l::"lam"  binds x in l ("Lam [_]. _" [100, 100] 100)
 
+thm lam.strong_induct
+
 lemma alpha_lam_raw_eqvt[eqvt]: "p \<bullet> (alpha_lam_raw x y) = alpha_lam_raw (p \<bullet> x) (p \<bullet> y)"
   unfolding alpha_lam_raw_def
   by perm_simp rule
@@ -378,6 +385,8 @@
   avoids b4: "x"
   by (simp_all add: fresh_star_def fresh_Pair  fresh_fact)
 
+thm beta.strong_induct
+
 text {* One-Reduction *}
 
 inductive 
diff -r 89158f401b07 -r e5d9b6bca88c Nominal/Nominal2_Base.thy
--- a/Nominal/Nominal2_Base.thy	Fri Apr 19 00:10:52 2013 +0100
+++ b/Nominal/Nominal2_Base.thy	Tue Jun 04 09:39:23 2013 +0100
@@ -354,7 +354,6 @@
   unfolding permute_atom_def
   by (metis Rep_perm_ext ext)
 
-
 subsection {* Permutations for permutations *}
 
 instantiation perm :: pt
@@ -1001,6 +1000,11 @@
   shows "p \<bullet> (A \<union> B) = (p \<bullet> A) \<union> (p \<bullet> B)"
   unfolding Un_def by simp
 
+lemma UNION_eqvt [eqvt]:
+  shows "p \<bullet> (UNION A f) = (UNION (p \<bullet> A) (p \<bullet> f))"
+unfolding UNION_eq
+by (perm_simp) (simp)
+
 lemma Diff_eqvt [eqvt]:
   fixes A B :: "'a::pt set"
   shows "p \<bullet> (A - B) = (p \<bullet> A) - (p \<bullet> B)"
@@ -1603,6 +1607,17 @@
     by blast
 qed
 
+lemma perm_eq_iff2:
+  fixes p q :: "perm"
+  shows "p = q \<longleftrightarrow> (\<forall>a::atom \<in> supp p \<union> supp q. p \<bullet> a = q \<bullet> a)"
+  unfolding perm_eq_iff
+  apply(auto)
+  apply(case_tac "a \<sharp> p \<and> a \<sharp> q")
+  apply(simp add: fresh_perm)
+  apply(simp add: fresh_def)
+  done
+
+
 instance perm :: fs
 by default (simp add: supp_perm finite_perm_lemma)
 
@@ -2017,15 +2032,13 @@
   assumes fin: "finite S"
   shows "(\<Union>x\<in>S. supp x) \<subseteq> supp S"
 proof -
-  have eqvt: "eqvt (\<lambda>S. \<Union> supp ` S)" 
-    unfolding eqvt_def 
-    by (perm_simp) (simp)
+  have eqvt: "eqvt (\<lambda>S. \<Union>x \<in> S. supp x)" 
+    unfolding eqvt_def by simp 
   have "(\<Union>x\<in>S. supp x) = supp (\<Union>x\<in>S. supp x)"
     by (rule supp_finite_atom_set[symmetric]) (rule Union_of_finite_supp_sets[OF fin])
-  also have "\<dots> = supp ((\<lambda>S. \<Union> supp ` S) S)" by simp
   also have "\<dots> \<subseteq> supp S" using eqvt
     by (rule supp_fun_app_eqvt)
-  finally show "(\<Union>x\<in>S. supp x) \<subseteq> supp S" .
+  finally show "(\<Union>x\<in>S. supp x) \<subseteq> supp S" .  
 qed
 
 lemma supp_of_finite_sets:
diff -r 89158f401b07 -r e5d9b6bca88c Nominal/nominal_function_core.ML
--- a/Nominal/nominal_function_core.ML	Fri Apr 19 00:10:52 2013 +0100
+++ b/Nominal/nominal_function_core.ML	Tue Jun 04 09:39:23 2013 +0100
@@ -501,8 +501,9 @@
       map2 (mk_uniqueness_clause thy globals compat_store eqvtlems invlems clausei) clauses replems
 
     fun elim_implies_eta A AB =
-      Thm.compose_no_flatten true (A, 0) 1 AB |> Seq.list_of |> the_single
- 
+      Thm.bicompose {flatten = false, match = true, incremented = false} (false, A, 0) 1 AB
+      |> Seq.list_of |> the_single
+
     val uniqueness = G_cases
       |> Thm.forall_elim (cterm_of thy lhs)
       |> Thm.forall_elim (cterm_of thy y)
diff -r 89158f401b07 -r e5d9b6bca88c Nominal/nominal_mutual.ML
--- a/Nominal/nominal_mutual.ML	Fri Apr 19 00:10:52 2013 +0100
+++ b/Nominal/nominal_mutual.ML	Tue Jun 04 09:39:23 2013 +0100
@@ -418,10 +418,6 @@
 
     val (mutual' as Mutual {n', parts, ST, RST, ...}, lthy'') = define_projections fixes mutual fsum lthy'
 
-    val mutual_cont = mk_partial_rules_mutual lthy'' cont mutual'
-
-    (* XXX *)
-
     (* defining the auxiliary graph *)
     fun mk_cases (MutualPart {i', fvar as (n, T), ...}) =
       let
@@ -446,6 +442,8 @@
     val ((G_aux, GIntro_aux_thms, _, G_aux_induct), lthy''') = 
       Nominal_Function_Core.inductive_def ((Binding.name G_name_aux, G_type), NoSyn) GIntros_aux lthy''
 
+    val mutual_cont = mk_partial_rules_mutual lthy''' cont mutual'
+
     (* proof of equivalence between graph and auxiliary graph *)
     val x = Var(("x", 0), ST)
     val y = Var(("y", 1), RST)