# HG changeset patch # User Cezary Kaliszyk # Date 1337847452 -7200 # Node ID 52730e5ec8cb6a89890da34a144b2428211dc3ee # Parent 8f51702e1f2ec1ae4985fe64a8e3316f61ff8174 Synchronize Nominal2_Base_Exec with Nominal2_Base, equivariance for Let, avoid overloading approx twice and changes for new isabelle diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/Ex/Exec/Lambda_Exec.thy --- a/Nominal/Ex/Exec/Lambda_Exec.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/Ex/Exec/Lambda_Exec.thy Thu May 24 10:17:32 2012 +0200 @@ -458,10 +458,6 @@ value "(atom N0 \ atom N1) \ (App (Var N0) (Lam [N1]. (Var N1)))" value "subst ((N0 \ N1) \ (App (Var N0) (Lam [N1]. (Var N1)))) N1 (Var N0)"*) -lemma [eqvt]: - "p \ Let x y = Let (p \ x) (p \ y)" - unfolding Let_def permute_fun_app_eq .. - end diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/Ex/SFT/Consts.thy --- a/Nominal/Ex/SFT/Consts.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/Ex/SFT/Consts.thy Thu May 24 10:17:32 2012 +0200 @@ -285,10 +285,10 @@ apply (rule lam2_fast_app, rule Lam_A, simp_all) done -definition "Num \ \[\[A1,A2,A3]\]\" +definition "NUM \ \[\[A1,A2,A3]\]\" -lemma supp_Num[simp]: - "supp Num = {}" - by (auto simp only: Num_def supp_ltgt supp_Pair supp_A supp_Cons supp_Nil) +lemma supp_NUM[simp]: + "supp NUM = {}" + by (auto simp only: NUM_def supp_ltgt supp_Pair supp_A supp_Cons supp_Nil) end diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/Ex/SFT/Theorem.thy --- a/Nominal/Ex/SFT/Theorem.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/Ex/SFT/Theorem.thy Thu May 24 10:17:32 2012 +0200 @@ -1,15 +1,15 @@ -header {* The main lemma about Num and the Second Fixed Point Theorem *} +header {* The main lemma about NUM and the Second Fixed Point Theorem *} theory Theorem imports Consts begin -lemmas [simp] = b3[OF bI] b1 b4 b5 supp_Num[unfolded Num_def supp_ltgt] Num_def lam.fresh[unfolded fresh_def] fresh_def b6 +lemmas [simp] = b3[OF bI] b1 b4 b5 supp_NUM[unfolded NUM_def supp_ltgt] NUM_def lam.fresh[unfolded fresh_def] fresh_def b6 lemmas app = Ltgt1_app -lemma Num: - shows "Num \ \M\ \ \\M\\" +lemma NUM: + shows "NUM \ \M\ \ \\M\\" proof (induct M rule: lam.induct) case (Var n) - have "Num \ \Var n\ = Num \ (VAR \ Var n)" by simp + have "NUM \ \Var n\ = NUM \ (VAR \ Var n)" by simp also have "... = \[\[A1,A2,A3]\]\ \ (VAR \ Var n)" by simp also have "... \ VAR \ Var n \ \[A1,A2,A3]\" using app . also have "... \ \[A1,A2,A3]\ \ Umn 2 2 \ Var n \ \[A1,A2,A3]\" using VAR_app . @@ -17,50 +17,50 @@ also have "... \ F1 \ Var n" using A_app(1) . also have "... \ APP \ \VAR\ \ (VAR \ Var n)" using F_app(1) . also have "... = \\Var n\\" by simp - finally show "Num \ \Var n\ \ \\Var n\\". + finally show "NUM \ \Var n\ \ \\Var n\\". next case (App M N) - assume IH: "Num \ \M\ \ \\M\\" "Num \ \N\ \ \\N\\" - have "Num \ \M \ N\ = Num \ (APP \ \M\ \ \N\)" by simp + assume IH: "NUM \ \M\ \ \\M\\" "NUM \ \N\ \ \\N\\" + have "NUM \ \M \ N\ = NUM \ (APP \ \M\ \ \N\)" by simp also have "... = \[\[A1,A2,A3]\]\ \ (APP \ \M\ \ \N\)" by simp also have "... \ APP \ \M\ \ \N\ \ \[A1,A2,A3]\" using app . also have "... \ \[A1,A2,A3]\ \ Umn 2 1 \ \M\ \ \N\ \ \[A1,A2,A3]\" using APP_app . also have "... \ A2 \ \M\ \ \N\ \ \[A1,A2,A3]\" using U_app by simp - also have "... \ F2 \ \M\ \ \N\ \ Num" using A_app(2) by simp - also have "... \ APP \ (APP \ \APP\ \ (Num \ \M\)) \ (Num \ \N\)" using F_app(2) . - also have "... \ APP \ (APP \ \APP\ \ (\\M\\)) \ (Num \ \N\)" using IH by simp + also have "... \ F2 \ \M\ \ \N\ \ NUM" using A_app(2) by simp + also have "... \ APP \ (APP \ \APP\ \ (NUM \ \M\)) \ (NUM \ \N\)" using F_app(2) . + also have "... \ APP \ (APP \ \APP\ \ (\\M\\)) \ (NUM \ \N\)" using IH by simp also have "... \ \\M \ N\\" using IH by simp - finally show "Num \ \M \ N\ \ \\M \ N\\". + finally show "NUM \ \M \ N\ \ \\M \ N\\". next case (Lam x P) - assume IH: "Num \ \P\ \ \\P\\" - have "Num \ \\ x. P\ = Num \ (Abs \ \ x. \P\)" by simp + assume IH: "NUM \ \P\ \ \\P\\" + have "NUM \ \\ x. P\ = NUM \ (Abs \ \ x. \P\)" by simp also have "... = \[\[A1,A2,A3]\]\ \ (Abs \ \ x. \P\)" by simp also have "... \ Abs \ (\ x. \P\) \ \[A1,A2,A3]\" using app . also have "... \ \[A1,A2,A3]\ \ Umn 2 0 \ (\ x. \P\) \ \[A1,A2,A3]\" using Abs_app . also have "... \ A3 \ (\ x. \P\) \ \[A1,A2,A3]\" using U_app by simp also have "... \ F3 \ (\ x. \P\) \ \[\[A1,A2,A3]\]\" using A_app(3) . - also have "... = F3 \ (\ x. \P\) \ Num" by simp - also have "... \ APP \ \Abs\ \ (Abs \ \ x. (Num \ ((\ x. \P\) \ Var x)))" by (rule F3_app) simp_all - also have "... \ APP \ \Abs\ \ (Abs \ \ x. (Num \ \P\))" using beta_app by simp + also have "... = F3 \ (\ x. \P\) \ NUM" by simp + also have "... \ APP \ \Abs\ \ (Abs \ \ x. (NUM \ ((\ x. \P\) \ Var x)))" by (rule F3_app) simp_all + also have "... \ APP \ \Abs\ \ (Abs \ \ x. (NUM \ \P\))" using beta_app by simp also have "... \ APP \ \Abs\ \ (Abs \ \ x. \\P\\)" using IH by simp also have "... = \\\ x. P\\" by simp - finally show "Num \ \\ x. P\ \ \\\ x. P\\" . + finally show "NUM \ \\ x. P\ \ \\\ x. P\\" . qed -lemmas [simp] = Ap Num -lemmas [simp del] = fresh_def Num_def +lemmas [simp] = Ap NUM +lemmas [simp del] = fresh_def NUM_def theorem SFP: fixes F :: lam shows "\X. X \ F \ \X\" proof - obtain x :: name where [simp]:"atom x \ F" using obtain_fresh by blast - def W \ "\x. (F \ (APP \ Var x \ (Num \ Var x)))" + def W \ "\x. (F \ (APP \ Var x \ (NUM \ Var x)))" def X \ "W \ \W\" have a: "X = W \ \W\" unfolding X_def .. - also have "... = (\x. (F \ (APP \ Var x \ (Num \ Var x)))) \ \W\" unfolding W_def .. - also have "... \ F \ (APP \ \W\ \ (Num \ \W\))" by simp + also have "... = (\x. (F \ (APP \ Var x \ (NUM \ Var x)))) \ \W\" unfolding W_def .. + also have "... \ F \ (APP \ \W\ \ (NUM \ \W\))" by simp also have "... \ F \ (APP \ \W\ \ \\W\\)" by simp also have "... \ F \ \W \ \W\\" by simp also have "... = F \ \X\" unfolding X_def .. diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/GPerm.thy --- a/Nominal/GPerm.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/GPerm.thy Thu May 24 10:17:32 2012 +0200 @@ -36,12 +36,12 @@ by (metis valid_perm_def image_set length_map len_set_eq_distinct) definition - perm_eq :: "('a \ 'a) list \ ('a \ 'a) list \ bool" (infix "\" 50) + perm_eq :: "('a \ 'a) list \ ('a \ 'a) list \ bool" where - "x \ y \ valid_perm x \ valid_perm y \ (perm_apply x = perm_apply y)" + "perm_eq x y \ valid_perm x \ valid_perm y \ (perm_apply x = perm_apply y)" lemma perm_eq_sym[sym]: - "x \ y \ y \ x" + "perm_eq x y \ perm_eq y x" by (auto simp add: perm_eq_def) lemma perm_eq_equivp: @@ -159,7 +159,7 @@ by (metis uminus_perm_raw_def) lemma uminus_perm_raw_rsp[simp]: - "x \ y \ map swap_pair x \ map swap_pair y" + "perm_eq x y \ perm_eq (map swap_pair x) (map swap_pair y)" by (auto simp add: fun_eq_iff perm_apply_minus[symmetric] perm_eq_def) lemma fst_snd_map_pair[simp]: @@ -233,11 +233,11 @@ done lemma perm_add_raw_rsp[simp]: - "x \ y \ xa \ ya \ perm_add_raw x xa \ perm_add_raw y ya" + "perm_eq x y \ perm_eq xa ya \ perm_eq (perm_add_raw x xa) (perm_add_raw y ya)" by (simp add: fun_eq_iff perm_add_apply perm_eq_def) lemma [simp]: - "a \ a \ valid_perm a" + "perm_eq a a \ valid_perm a" by (simp_all add: perm_eq_def) instantiation gperm :: (type) group_add @@ -276,7 +276,7 @@ by (induct y) (auto split: if_splits) lemma perm_eq_not_eq_same: - "x \ y \ {xa \ set x. fst xa \ snd xa} = {x \ set y. fst x \ snd x}" + "perm_eq x y \ {xa \ set x. fst xa \ snd xa} = {x \ set y. fst x \ snd x}" unfolding perm_eq_def set_eq_iff apply auto apply (subgoal_tac "perm_apply x a = b") @@ -315,7 +315,7 @@ by (metis in_set_in_dpr2 pair_perm_apply perm_apply_in_set valid_perm_def) lemma dest_perm_raw_eq[simp]: - "valid_perm x \ valid_perm y \ (dest_perm_raw x = dest_perm_raw y) = (x \ y)" + "valid_perm x \ valid_perm y \ (dest_perm_raw x = dest_perm_raw y) = perm_eq x y" apply (auto simp add: perm_eq_def) apply (metis in_set_in_dpr3 fun_eq_iff) unfolding dest_perm_raw_def @@ -371,8 +371,8 @@ by simp (rule sorted_sort_id[OF sorted_sort]) lemma valid_dest_perm_raw_eq[simp]: - "valid_perm p \ dest_perm_raw p \ p" - "valid_perm p \ p \ dest_perm_raw p" + "valid_perm p \ perm_eq (dest_perm_raw p) p" + "valid_perm p \ perm_eq p (dest_perm_raw p)" by (simp_all add: dest_perm_raw_eq[symmetric]) lemma mk_perm_dest_perm[code abstype]: diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/Nominal2_Base.thy --- a/Nominal/Nominal2_Base.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/Nominal2_Base.thy Thu May 24 10:17:32 2012 +0200 @@ -1093,6 +1093,9 @@ unfolding finite_def by (perm_simp) (rule refl) +lemma Let_eqvt [eqvt]: + "p \ Let x y = Let (p \ x) (p \ y)" + unfolding Let_def permute_fun_app_eq .. subsubsection {* Equivariance for product operations *} diff -r 8f51702e1f2e -r 52730e5ec8cb Nominal/Nominal2_Base_Exec.thy --- a/Nominal/Nominal2_Base_Exec.thy Wed May 23 23:57:27 2012 +0100 +++ b/Nominal/Nominal2_Base_Exec.thy Thu May 24 10:17:32 2012 +0200 @@ -110,20 +110,15 @@ lift_definition mk_perm :: "atom gperm \ perm" is "\p. if sort_respecting p then p else 0" by simp -(*lemma sort_respecting_Rep_perm [simp, intro]: - "sort_respecting (Rep_perm p)" - using Rep_perm [of p] by simp*) - lemma Rep_perm_mk_perm [simp]: "Rep_perm (mk_perm p) = (if sort_respecting p then p else 0)" by (simp add: mk_perm_def Abs_perm_inverse) -(*lemma mk_perm_Rep_perm [simp, code abstype]: - "mk_perm (Rep_perm dxs) = dxs" - by (simp add: mk_perm_def Rep_perm_inverse)*) - instance perm :: size .. + +subsection {* Permutations form a (multiplicative) group *} + instantiation perm :: group_add begin @@ -158,6 +153,9 @@ end + +section {* Implementation of swappings *} + lift_definition swap :: "atom \ atom \ perm" ("'(_ \ _')") is "(\a b. (if sort_of a = sort_of b then mk_perm (gswap a b) else 0))" . @@ -1013,6 +1011,9 @@ unfolding finite_def by (perm_simp) (rule refl) +lemma Let_eqvt [eqvt]: + "p \ Let x y = Let (p \ x) (p \ y)" + unfolding Let_def permute_fun_app_eq .. subsubsection {* Equivariance for product operations *} @@ -2721,6 +2722,40 @@ shows "as \* atom b \ as \* b" by (simp add: fresh_star_def fresh_atom_at_base) +lemma if_fresh_at_base [simp]: + shows "atom a \ x \ P (if a = x then t else s) = P s" + and "atom a \ x \ P (if x = a then t else s) = P s" +by (simp_all add: fresh_at_base) + +simproc_setup fresh_ineq ("x \ (y::'a::at_base)") = {* fn _ => fn ss => fn ctrm => + let + fun first_is_neg lhs rhs [] = NONE + | first_is_neg lhs rhs (thm::thms) = + (case Thm.prop_of thm of + _ $ (@{term "HOL.Not"} $ (Const ("HOL.eq", _) $ l $ r)) => + (if l = lhs andalso r = rhs then SOME(thm) + else if r = lhs andalso l = rhs then SOME(thm RS @{thm not_sym}) + else NONE) + | _ => first_is_neg lhs rhs thms) + + val simp_thms = @{thms fresh_Pair fresh_at_base atom_eq_iff} + val prems = Simplifier.prems_of ss + |> filter (fn thm => case Thm.prop_of thm of + _ $ (Const (@{const_name fresh}, _) $ _ $ _) => true | _ => false) + |> map (simplify (HOL_basic_ss addsimps simp_thms)) + |> map HOLogic.conj_elims + |> flat + in + case term_of ctrm of + @{term "HOL.Not"} $ (Const ("HOL.eq", _) $ lhs $ rhs) => + (case first_is_neg lhs rhs prems of + SOME(thm) => SOME(thm RS @{thm Eq_TrueI}) + | NONE => NONE) + | _ => NONE + end +*} + + instance at_base < fs proof qed (simp add: supp_at_base)