# HG changeset patch # User Christian Urban # Date 1323104756 0 # Node ID 6613514ff6cbcee6e1fd1080cd107dbf832f8a36 # Parent f6275afb868aa0adb2f833bef4ae3c2936d112f5 tiny improvement by removing one unnecessary assumption diff -r f6275afb868a -r 6613514ff6cb Nominal/Nominal2_Abs.thy --- a/Nominal/Nominal2_Abs.thy Mon Dec 05 16:12:44 2011 +0000 +++ b/Nominal/Nominal2_Abs.thy Mon Dec 05 17:05:56 2011 +0000 @@ -879,17 +879,16 @@ subsection {* Renaming of bodies of abstractions *} -(* FIXME: finiteness assumption is not needed *) - lemma Abs_rename_set: fixes x::"'a::fs" assumes a: "(p \ bs) \* x" - and b: "finite bs" + (*and b: "finite bs"*) shows "\q. [bs]set. x = [p \ bs]set. (q \ x) \ q \ bs = p \ bs" proof - from set_renaming_perm2 obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast - have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) + have ***: "q \ bs = p \ bs" using * + unfolding permute_set_eq_image image_def by auto have "[bs]set. x = q \ ([bs]set. x)" apply(rule perm_supp_eq[symmetric]) using a ** @@ -904,12 +903,13 @@ lemma Abs_rename_res: fixes x::"'a::fs" assumes a: "(p \ bs) \* x" - and b: "finite bs" + (*and b: "finite bs"*) shows "\q. [bs]res. x = [p \ bs]res. (q \ x) \ q \ bs = p \ bs" proof - from set_renaming_perm2 obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast - have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) + have ***: "q \ bs = p \ bs" using * + unfolding permute_set_eq_image image_def by auto have "[bs]res. x = q \ ([bs]res. x)" apply(rule perm_supp_eq[symmetric]) using a ** @@ -946,16 +946,16 @@ lemma Abs_rename_set': fixes x::"'a::fs" assumes a: "(p \ bs) \* x" - and b: "finite bs" + (*and b: "finite bs"*) shows "\q. [bs]set. x = [q \ bs]set. (q \ x) \ q \ bs = p \ bs" -using Abs_rename_set[OF a b] by metis +using Abs_rename_set[OF a] by metis lemma Abs_rename_res': fixes x::"'a::fs" assumes a: "(p \ bs) \* x" - and b: "finite bs" + (*and b: "finite bs"*) shows "\q. [bs]res. x = [q \ bs]res. (q \ x) \ q \ bs = p \ bs" -using Abs_rename_res[OF a b] by metis +using Abs_rename_res[OF a] by metis lemma Abs_rename_lst': fixes x::"'a::fs" diff -r f6275afb868a -r 6613514ff6cb Nominal/nominal_dt_quot.ML --- a/Nominal/nominal_dt_quot.ML Mon Dec 05 16:12:44 2011 +0000 +++ b/Nominal/nominal_dt_quot.ML Mon Dec 05 17:05:56 2011 +0000 @@ -487,8 +487,7 @@ Exists q. [as].x = [p o as].(q o x) for non-recursive binders Exists q. [as].x = [q o as].(q o x) for recursive binders *) -fun abs_eq_thm ctxt fprops p parms bn_finite_thms bn_eqvt permute_bns - (bclause as (BC (bmode, binders, bodies))) = +fun abs_eq_thm ctxt fprops p parms bn_eqvt permute_bns (bclause as (BC (bmode, binders, bodies))) = case binders of [] => [] | _ => @@ -510,9 +509,9 @@ |> (fn t => HOLogic.mk_exists ("q", @{typ "perm"}, t)) |> HOLogic.mk_Trueprop - val ss = fprops @ bn_finite_thms @ @{thms set.simps set_append union_eqvt} + val ss = fprops @ @{thms set.simps set_append union_eqvt} @ @{thms fresh_star_Un fresh_star_Pair fresh_star_list fresh_star_singleton fresh_star_fset - fresh_star_set} @ @{thms finite.intros finite_fset} + fresh_star_set} val tac1 = if rec_flag @@ -548,7 +547,7 @@ REPEAT o (etac @{thm conjE})])) [fthm] ctxt val abs_eq_thms = flat - (map (abs_eq_thm ctxt fprops (term_of fperm) parms bn_finite_thms bn_eqvt permute_bns) bclauses) + (map (abs_eq_thm ctxt fprops (term_of fperm) parms bn_eqvt permute_bns) bclauses) val ((_, eqs), ctxt'') = Obtain.result (K (EVERY1