# HG changeset patch # User blanchet # Date 1394114234 -3600 # Node ID f20d1db5aa3c6a4ce641e39351958b6c41c18775 # Parent 18e52e8c63001e79575c336af6e048c6546e1333 renamed 'set_rel' to 'rel_set' diff -r 18e52e8c6300 -r f20d1db5aa3c NEWS --- a/NEWS Thu Mar 06 14:25:55 2014 +0100 +++ b/NEWS Thu Mar 06 14:57:14 2014 +0100 @@ -195,6 +195,7 @@ map_pair ~> prod_map fset_rel ~> rel_fset cset_rel ~> rel_cset + set_rel ~> rel_set * New theory: Cardinals/Ordinal_Arithmetic.thy diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/BNF_Examples/Derivation_Trees/DTree.thy --- a/src/HOL/BNF_Examples/Derivation_Trees/DTree.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/BNF_Examples/Derivation_Trees/DTree.thy Thu Mar 06 14:57:14 2014 +0100 @@ -60,17 +60,17 @@ shows "tr = tr'" by (metis Node_root_cont assms) -lemma set_rel_cont: -"set_rel \ (cont tr1) (cont tr2) = rel_fset \ (ccont tr1) (ccont tr2)" +lemma rel_set_cont: +"rel_set \ (cont tr1) (cont tr2) = rel_fset \ (ccont tr1) (ccont tr2)" unfolding cont_def comp_def rel_fset_fset .. lemma dtree_coinduct[elim, consumes 1, case_names Lift, induct pred: "HOL.eq"]: assumes phi: "\ tr1 tr2" and Lift: "\ tr1 tr2. \ tr1 tr2 \ - root tr1 = root tr2 \ set_rel (sum_rel op = \) (cont tr1) (cont tr2)" + root tr1 = root tr2 \ rel_set (sum_rel op = \) (cont tr1) (cont tr2)" shows "tr1 = tr2" using phi apply(elim dtree.coinduct) -apply(rule Lift[unfolded set_rel_cont]) . +apply(rule Lift[unfolded rel_set_cont]) . lemma unfold: "root (unfold rt ct b) = rt b" diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/BNF_Examples/Derivation_Trees/Parallel.thy --- a/src/HOL/BNF_Examples/Derivation_Trees/Parallel.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/BNF_Examples/Derivation_Trees/Parallel.thy Thu Mar 06 14:57:14 2014 +0100 @@ -67,10 +67,10 @@ subsection{* Structural Coinduction Proofs *} -lemma set_rel_sum_rel_eq[simp]: -"set_rel (sum_rel (op =) \) A1 A2 \ - Inl -` A1 = Inl -` A2 \ set_rel \ (Inr -` A1) (Inr -` A2)" -unfolding set_rel_sum_rel set_rel_eq .. +lemma rel_set_sum_rel_eq[simp]: +"rel_set (sum_rel (op =) \) A1 A2 \ + Inl -` A1 = Inl -` A2 \ rel_set \ (Inr -` A1) (Inr -` A2)" +unfolding rel_set_sum_rel rel_set_eq .. (* Detailed proofs of commutativity and associativity: *) theorem par_com: "tr1 \ tr2 = tr2 \ tr1" @@ -79,7 +79,7 @@ {fix trA trB assume "?\ trA trB" hence "trA = trB" apply (induct rule: dtree_coinduct) - unfolding set_rel_sum_rel set_rel_eq unfolding set_rel_def proof safe + unfolding rel_set_sum_rel rel_set_eq unfolding rel_set_def proof safe fix tr1 tr2 show "root (tr1 \ tr2) = root (tr2 \ tr1)" unfolding root_par by (rule Nplus_comm) next @@ -114,7 +114,7 @@ {fix trA trB assume "?\ trA trB" hence "trA = trB" apply (induct rule: dtree_coinduct) - unfolding set_rel_sum_rel set_rel_eq unfolding set_rel_def proof safe + unfolding rel_set_sum_rel rel_set_eq unfolding rel_set_def proof safe fix tr1 tr2 tr3 show "root ((tr1 \ tr2) \ tr3) = root (tr1 \ (tr2 \ tr3))" unfolding root_par by (rule Nplus_assoc) next diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/Library/FSet.thy --- a/src/HOL/Library/FSet.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/Library/FSet.thy Thu Mar 06 14:57:14 2014 +0100 @@ -78,14 +78,14 @@ lemma right_total_Inf_fset_transfer: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "right_total A" - shows "(set_rel (set_rel A) ===> set_rel A) + shows "(rel_set (rel_set A) ===> rel_set A) (\S. if finite (Inter S \ Collect (Domainp A)) then Inter S \ Collect (Domainp A) else {}) (\S. if finite (Inf S) then Inf S else {})" by transfer_prover lemma Inf_fset_transfer: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "bi_total A" - shows "(set_rel (set_rel A) ===> set_rel A) (\A. if finite (Inf A) then Inf A else {}) + shows "(rel_set (rel_set A) ===> rel_set A) (\A. if finite (Inf A) then Inf A else {}) (\A. if finite (Inf A) then Inf A else {})" by transfer_prover @@ -94,7 +94,7 @@ lemma Sup_fset_transfer: assumes [transfer_rule]: "bi_unique A" - shows "(set_rel (set_rel A) ===> set_rel A) (\A. if finite (Sup A) then Sup A else {}) + shows "(rel_set (rel_set A) ===> rel_set A) (\A. if finite (Sup A) then Sup A else {}) (\A. if finite (Sup A) then Sup A else {})" by transfer_prover lift_definition Sup_fset :: "'a fset set \ 'a fset" is "\A. if finite (Sup A) then Sup A else {}" @@ -103,7 +103,7 @@ lemma finite_Sup: "\z. finite z \ (\a. a \ X \ a \ z) \ finite (Sup X)" by (auto intro: finite_subset) -lemma transfer_bdd_below[transfer_rule]: "(set_rel (pcr_fset op =) ===> op =) bdd_below bdd_below" +lemma transfer_bdd_below[transfer_rule]: "(rel_set (pcr_fset op =) ===> op =) bdd_below bdd_below" by auto instance @@ -762,53 +762,53 @@ subsubsection {* Relator and predicator properties *} -lift_definition rel_fset :: "('a \ 'b \ bool) \ 'a fset \ 'b fset \ bool" is set_rel -parametric set_rel_transfer . +lift_definition rel_fset :: "('a \ 'b \ bool) \ 'a fset \ 'b fset \ bool" is rel_set +parametric rel_set_transfer . lemma rel_fset_alt_def: "rel_fset R = (\A B. (\x.\y. x|\|A \ y|\|B \ R x y) \ (\y. \x. y|\|B \ x|\|A \ R x y))" apply (rule ext)+ apply transfer' -apply (subst set_rel_def[unfolded fun_eq_iff]) +apply (subst rel_set_def[unfolded fun_eq_iff]) by blast lemma rel_fset_conversep: "rel_fset (conversep R) = conversep (rel_fset R)" unfolding rel_fset_alt_def by auto -lemmas rel_fset_eq [relator_eq] = set_rel_eq[Transfer.transferred] +lemmas rel_fset_eq [relator_eq] = rel_set_eq[Transfer.transferred] lemma rel_fset_mono[relator_mono]: "A \ B \ rel_fset A \ rel_fset B" unfolding rel_fset_alt_def by blast -lemma finite_set_rel: +lemma finite_rel_set: assumes fin: "finite X" "finite Z" - assumes R_S: "set_rel (R OO S) X Z" - shows "\Y. finite Y \ set_rel R X Y \ set_rel S Y Z" + assumes R_S: "rel_set (R OO S) X Z" + shows "\Y. finite Y \ rel_set R X Y \ rel_set S Y Z" proof - obtain f where f: "\x\X. R x (f x) \ (\z\Z. S (f x) z)" apply atomize_elim apply (subst bchoice_iff[symmetric]) - using R_S[unfolded set_rel_def OO_def] by blast + using R_S[unfolded rel_set_def OO_def] by blast obtain g where g: "\z\Z. S (g z) z \ (\x\X. R x (g z))" apply atomize_elim apply (subst bchoice_iff[symmetric]) - using R_S[unfolded set_rel_def OO_def] by blast + using R_S[unfolded rel_set_def OO_def] by blast let ?Y = "f ` X \ g ` Z" have "finite ?Y" by (simp add: fin) - moreover have "set_rel R X ?Y" - unfolding set_rel_def + moreover have "rel_set R X ?Y" + unfolding rel_set_def using f g by clarsimp blast - moreover have "set_rel S ?Y Z" - unfolding set_rel_def + moreover have "rel_set S ?Y Z" + unfolding rel_set_def using f g by clarsimp blast ultimately show ?thesis by metis qed lemma rel_fset_OO[relator_distr]: "rel_fset R OO rel_fset S = rel_fset (R OO S)" apply (rule ext)+ -by transfer (auto intro: finite_set_rel set_rel_OO[unfolded fun_eq_iff, rule_format, THEN iffD1]) +by transfer (auto intro: finite_rel_set rel_set_OO[unfolded fun_eq_iff, rule_format, THEN iffD1]) lemma Domainp_fset[relator_domain]: assumes "Domainp T = P" @@ -832,7 +832,7 @@ apply (subst(asm) choice_iff) apply clarsimp apply (rename_tac A f y, rule_tac x = "f ` y" in exI) -by (auto simp add: set_rel_def) +by (auto simp add: rel_set_def) lemma left_total_rel_fset[reflexivity_rule]: "left_total A \ left_total (rel_fset A)" unfolding left_total_def @@ -840,10 +840,10 @@ apply (subst(asm) choice_iff) apply clarsimp apply (rename_tac A f y, rule_tac x = "f ` y" in exI) -by (auto simp add: set_rel_def) +by (auto simp add: rel_set_def) -lemmas right_unique_rel_fset[transfer_rule] = right_unique_set_rel[Transfer.transferred] -lemmas left_unique_rel_fset[reflexivity_rule] = left_unique_set_rel[Transfer.transferred] +lemmas right_unique_rel_fset[transfer_rule] = right_unique_rel_set[Transfer.transferred] +lemmas left_unique_rel_fset[reflexivity_rule] = left_unique_rel_set[Transfer.transferred] thm right_unique_rel_fset left_unique_rel_fset @@ -911,7 +911,7 @@ "((A ===> B ===> op =) ===> rel_fset A ===> rel_fset B ===> op =) rel_fset rel_fset" unfolding fun_rel_def - using set_rel_transfer[unfolded fun_rel_def,rule_format, Transfer.transferred, where A = A and B = B] + using rel_set_transfer[unfolded fun_rel_def,rule_format, Transfer.transferred, where A = A and B = B] by simp lemma bind_transfer [transfer_rule]: @@ -945,7 +945,7 @@ using subset_transfer[unfolded fun_rel_def, rule_format, Transfer.transferred] by blast lemma fSup_transfer [transfer_rule]: - "bi_unique A \ (set_rel (rel_fset A) ===> rel_fset A) Sup Sup" + "bi_unique A \ (rel_set (rel_fset A) ===> rel_fset A) Sup Sup" using assms unfolding fun_rel_def apply clarify apply transfer' @@ -955,7 +955,7 @@ lemma fInf_transfer [transfer_rule]: assumes "bi_unique A" and "bi_total A" - shows "(set_rel (rel_fset A) ===> rel_fset A) Inf Inf" + shows "(rel_set (rel_fset A) ===> rel_fset A) Inf Inf" using assms unfolding fun_rel_def apply clarify apply transfer' @@ -986,7 +986,7 @@ lemma rel_fset_alt: "rel_fset R a b \ (\t \ fset a. \u \ fset b. R t u) \ (\t \ fset b. \u \ fset a. R u t)" -by transfer (simp add: set_rel_def) +by transfer (simp add: rel_set_def) lemma fset_to_fset: "finite A \ fset (the_inv fset A) = A" apply (rule f_the_inv_into_f[unfolded inj_on_def]) @@ -1037,7 +1037,7 @@ apply transfer apply simp done -lemma rel_fset_fset: "set_rel \ (fset A1) (fset A2) = rel_fset \ A1 A2" +lemma rel_fset_fset: "rel_set \ (fset A1) (fset A2) = rel_fset \ A1 A2" by transfer (rule refl) end @@ -1049,50 +1049,50 @@ (* Set vs. sum relators: *) -lemma set_rel_sum_rel[simp]: -"set_rel (sum_rel \ \) A1 A2 \ - set_rel \ (Inl -` A1) (Inl -` A2) \ set_rel \ (Inr -` A1) (Inr -` A2)" +lemma rel_set_sum_rel[simp]: +"rel_set (sum_rel \ \) A1 A2 \ + rel_set \ (Inl -` A1) (Inl -` A2) \ rel_set \ (Inr -` A1) (Inr -` A2)" (is "?L \ ?Rl \ ?Rr") proof safe assume L: "?L" - show ?Rl unfolding set_rel_def Bex_def vimage_eq proof safe + show ?Rl unfolding rel_set_def Bex_def vimage_eq proof safe fix l1 assume "Inl l1 \ A1" then obtain a2 where a2: "a2 \ A2" and "sum_rel \ \ (Inl l1) a2" - using L unfolding set_rel_def by auto + using L unfolding rel_set_def by auto then obtain l2 where "a2 = Inl l2 \ \ l1 l2" by (cases a2, auto) thus "\ l2. Inl l2 \ A2 \ \ l1 l2" using a2 by auto next fix l2 assume "Inl l2 \ A2" then obtain a1 where a1: "a1 \ A1" and "sum_rel \ \ a1 (Inl l2)" - using L unfolding set_rel_def by auto + using L unfolding rel_set_def by auto then obtain l1 where "a1 = Inl l1 \ \ l1 l2" by (cases a1, auto) thus "\ l1. Inl l1 \ A1 \ \ l1 l2" using a1 by auto qed - show ?Rr unfolding set_rel_def Bex_def vimage_eq proof safe + show ?Rr unfolding rel_set_def Bex_def vimage_eq proof safe fix r1 assume "Inr r1 \ A1" then obtain a2 where a2: "a2 \ A2" and "sum_rel \ \ (Inr r1) a2" - using L unfolding set_rel_def by auto + using L unfolding rel_set_def by auto then obtain r2 where "a2 = Inr r2 \ \ r1 r2" by (cases a2, auto) thus "\ r2. Inr r2 \ A2 \ \ r1 r2" using a2 by auto next fix r2 assume "Inr r2 \ A2" then obtain a1 where a1: "a1 \ A1" and "sum_rel \ \ a1 (Inr r2)" - using L unfolding set_rel_def by auto + using L unfolding rel_set_def by auto then obtain r1 where "a1 = Inr r1 \ \ r1 r2" by (cases a1, auto) thus "\ r1. Inr r1 \ A1 \ \ r1 r2" using a1 by auto qed next assume Rl: "?Rl" and Rr: "?Rr" - show ?L unfolding set_rel_def Bex_def vimage_eq proof safe + show ?L unfolding rel_set_def Bex_def vimage_eq proof safe fix a1 assume a1: "a1 \ A1" show "\ a2. a2 \ A2 \ sum_rel \ \ a1 a2" proof(cases a1) case (Inl l1) then obtain l2 where "Inl l2 \ A2 \ \ l1 l2" - using Rl a1 unfolding set_rel_def by blast + using Rl a1 unfolding rel_set_def by blast thus ?thesis unfolding Inl by auto next case (Inr r1) then obtain r2 where "Inr r2 \ A2 \ \ r1 r2" - using Rr a1 unfolding set_rel_def by blast + using Rr a1 unfolding rel_set_def by blast thus ?thesis unfolding Inr by auto qed next @@ -1100,11 +1100,11 @@ show "\ a1. a1 \ A1 \ sum_rel \ \ a1 a2" proof(cases a2) case (Inl l2) then obtain l1 where "Inl l1 \ A1 \ \ l1 l2" - using Rl a2 unfolding set_rel_def by blast + using Rl a2 unfolding rel_set_def by blast thus ?thesis unfolding Inl by auto next case (Inr r2) then obtain r1 where "Inr r1 \ A1 \ \ r1 r2" - using Rr a2 unfolding set_rel_def by blast + using Rr a2 unfolding rel_set_def by blast thus ?thesis unfolding Inr by auto qed qed diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/Library/Mapping.thy --- a/src/HOL/Library/Mapping.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/Library/Mapping.thy Thu Mar 06 14:57:14 2014 +0100 @@ -37,7 +37,7 @@ lemma dom_transfer: assumes [transfer_rule]: "bi_total A" - shows "((A ===> rel_option B) ===> set_rel A) dom dom" + shows "((A ===> rel_option B) ===> rel_set A) dom dom" unfolding dom_def[abs_def] equal_None_def[symmetric] by transfer_prover diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/Lifting_Set.thy --- a/src/HOL/Lifting_Set.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/Lifting_Set.thy Thu Mar 06 14:57:14 2014 +0100 @@ -10,90 +10,90 @@ subsection {* Relator and predicator properties *} -definition set_rel :: "('a \ 'b \ bool) \ 'a set \ 'b set \ bool" - where "set_rel R = (\A B. (\x\A. \y\B. R x y) \ (\y\B. \x\A. R x y))" +definition rel_set :: "('a \ 'b \ bool) \ 'a set \ 'b set \ bool" + where "rel_set R = (\A B. (\x\A. \y\B. R x y) \ (\y\B. \x\A. R x y))" -lemma set_relI: +lemma rel_setI: assumes "\x. x \ A \ \y\B. R x y" assumes "\y. y \ B \ \x\A. R x y" - shows "set_rel R A B" - using assms unfolding set_rel_def by simp + shows "rel_set R A B" + using assms unfolding rel_set_def by simp -lemma set_relD1: "\ set_rel R A B; x \ A \ \ \y \ B. R x y" - and set_relD2: "\ set_rel R A B; y \ B \ \ \x \ A. R x y" -by(simp_all add: set_rel_def) +lemma rel_setD1: "\ rel_set R A B; x \ A \ \ \y \ B. R x y" + and rel_setD2: "\ rel_set R A B; y \ B \ \ \x \ A. R x y" +by(simp_all add: rel_set_def) -lemma set_rel_conversep [simp]: "set_rel A\\ = (set_rel A)\\" - unfolding set_rel_def by auto +lemma rel_set_conversep [simp]: "rel_set A\\ = (rel_set A)\\" + unfolding rel_set_def by auto -lemma set_rel_eq [relator_eq]: "set_rel (op =) = (op =)" - unfolding set_rel_def fun_eq_iff by auto +lemma rel_set_eq [relator_eq]: "rel_set (op =) = (op =)" + unfolding rel_set_def fun_eq_iff by auto -lemma set_rel_mono[relator_mono]: +lemma rel_set_mono[relator_mono]: assumes "A \ B" - shows "set_rel A \ set_rel B" -using assms unfolding set_rel_def by blast + shows "rel_set A \ rel_set B" +using assms unfolding rel_set_def by blast -lemma set_rel_OO[relator_distr]: "set_rel R OO set_rel S = set_rel (R OO S)" +lemma rel_set_OO[relator_distr]: "rel_set R OO rel_set S = rel_set (R OO S)" apply (rule sym) apply (intro ext, rename_tac X Z) apply (rule iffI) apply (rule_tac b="{y. (\x\X. R x y) \ (\z\Z. S y z)}" in relcomppI) - apply (simp add: set_rel_def, fast) - apply (simp add: set_rel_def, fast) - apply (simp add: set_rel_def, fast) + apply (simp add: rel_set_def, fast) + apply (simp add: rel_set_def, fast) + apply (simp add: rel_set_def, fast) done lemma Domainp_set[relator_domain]: assumes "Domainp T = R" - shows "Domainp (set_rel T) = (\A. Ball A R)" -using assms unfolding set_rel_def Domainp_iff[abs_def] + shows "Domainp (rel_set T) = (\A. Ball A R)" +using assms unfolding rel_set_def Domainp_iff[abs_def] apply (intro ext) apply (rule iffI) apply blast apply (rename_tac A, rule_tac x="{y. \x\A. T x y}" in exI, fast) done -lemma left_total_set_rel[reflexivity_rule]: - "left_total A \ left_total (set_rel A)" - unfolding left_total_def set_rel_def +lemma left_total_rel_set[reflexivity_rule]: + "left_total A \ left_total (rel_set A)" + unfolding left_total_def rel_set_def apply safe apply (rename_tac X, rule_tac x="{y. \x\X. A x y}" in exI, fast) done -lemma left_unique_set_rel[reflexivity_rule]: - "left_unique A \ left_unique (set_rel A)" - unfolding left_unique_def set_rel_def +lemma left_unique_rel_set[reflexivity_rule]: + "left_unique A \ left_unique (rel_set A)" + unfolding left_unique_def rel_set_def by fast -lemma right_total_set_rel [transfer_rule]: - "right_total A \ right_total (set_rel A)" -using left_total_set_rel[of "A\\"] by simp +lemma right_total_rel_set [transfer_rule]: + "right_total A \ right_total (rel_set A)" +using left_total_rel_set[of "A\\"] by simp -lemma right_unique_set_rel [transfer_rule]: - "right_unique A \ right_unique (set_rel A)" - unfolding right_unique_def set_rel_def by fast +lemma right_unique_rel_set [transfer_rule]: + "right_unique A \ right_unique (rel_set A)" + unfolding right_unique_def rel_set_def by fast -lemma bi_total_set_rel [transfer_rule]: - "bi_total A \ bi_total (set_rel A)" -by(simp add: bi_total_conv_left_right left_total_set_rel right_total_set_rel) +lemma bi_total_rel_set [transfer_rule]: + "bi_total A \ bi_total (rel_set A)" +by(simp add: bi_total_conv_left_right left_total_rel_set right_total_rel_set) -lemma bi_unique_set_rel [transfer_rule]: - "bi_unique A \ bi_unique (set_rel A)" - unfolding bi_unique_def set_rel_def by fast +lemma bi_unique_rel_set [transfer_rule]: + "bi_unique A \ bi_unique (rel_set A)" + unfolding bi_unique_def rel_set_def by fast lemma set_invariant_commute [invariant_commute]: - "set_rel (Lifting.invariant P) = Lifting.invariant (\A. Ball A P)" - unfolding fun_eq_iff set_rel_def Lifting.invariant_def Ball_def by fast + "rel_set (Lifting.invariant P) = Lifting.invariant (\A. Ball A P)" + unfolding fun_eq_iff rel_set_def Lifting.invariant_def Ball_def by fast subsection {* Quotient theorem for the Lifting package *} lemma Quotient_set[quot_map]: assumes "Quotient R Abs Rep T" - shows "Quotient (set_rel R) (image Abs) (image Rep) (set_rel T)" + shows "Quotient (rel_set R) (image Abs) (image Rep) (rel_set T)" using assms unfolding Quotient_alt_def4 - apply (simp add: set_rel_OO[symmetric]) - apply (simp add: set_rel_def, fast) + apply (simp add: rel_set_OO[symmetric]) + apply (simp add: rel_set_def, fast) done subsection {* Transfer rules for the Transfer package *} @@ -104,143 +104,143 @@ begin interpretation lifting_syntax . -lemma empty_transfer [transfer_rule]: "(set_rel A) {} {}" - unfolding set_rel_def by simp +lemma empty_transfer [transfer_rule]: "(rel_set A) {} {}" + unfolding rel_set_def by simp lemma insert_transfer [transfer_rule]: - "(A ===> set_rel A ===> set_rel A) insert insert" - unfolding fun_rel_def set_rel_def by auto + "(A ===> rel_set A ===> rel_set A) insert insert" + unfolding fun_rel_def rel_set_def by auto lemma union_transfer [transfer_rule]: - "(set_rel A ===> set_rel A ===> set_rel A) union union" - unfolding fun_rel_def set_rel_def by auto + "(rel_set A ===> rel_set A ===> rel_set A) union union" + unfolding fun_rel_def rel_set_def by auto lemma Union_transfer [transfer_rule]: - "(set_rel (set_rel A) ===> set_rel A) Union Union" - unfolding fun_rel_def set_rel_def by simp fast + "(rel_set (rel_set A) ===> rel_set A) Union Union" + unfolding fun_rel_def rel_set_def by simp fast lemma image_transfer [transfer_rule]: - "((A ===> B) ===> set_rel A ===> set_rel B) image image" - unfolding fun_rel_def set_rel_def by simp fast + "((A ===> B) ===> rel_set A ===> rel_set B) image image" + unfolding fun_rel_def rel_set_def by simp fast lemma UNION_transfer [transfer_rule]: - "(set_rel A ===> (A ===> set_rel B) ===> set_rel B) UNION UNION" + "(rel_set A ===> (A ===> rel_set B) ===> rel_set B) UNION UNION" unfolding SUP_def [abs_def] by transfer_prover lemma Ball_transfer [transfer_rule]: - "(set_rel A ===> (A ===> op =) ===> op =) Ball Ball" - unfolding set_rel_def fun_rel_def by fast + "(rel_set A ===> (A ===> op =) ===> op =) Ball Ball" + unfolding rel_set_def fun_rel_def by fast lemma Bex_transfer [transfer_rule]: - "(set_rel A ===> (A ===> op =) ===> op =) Bex Bex" - unfolding set_rel_def fun_rel_def by fast + "(rel_set A ===> (A ===> op =) ===> op =) Bex Bex" + unfolding rel_set_def fun_rel_def by fast lemma Pow_transfer [transfer_rule]: - "(set_rel A ===> set_rel (set_rel A)) Pow Pow" - apply (rule fun_relI, rename_tac X Y, rule set_relI) + "(rel_set A ===> rel_set (rel_set A)) Pow Pow" + apply (rule fun_relI, rename_tac X Y, rule rel_setI) apply (rename_tac X', rule_tac x="{y\Y. \x\X'. A x y}" in rev_bexI, clarsimp) - apply (simp add: set_rel_def, fast) + apply (simp add: rel_set_def, fast) apply (rename_tac Y', rule_tac x="{x\X. \y\Y'. A x y}" in rev_bexI, clarsimp) - apply (simp add: set_rel_def, fast) + apply (simp add: rel_set_def, fast) done -lemma set_rel_transfer [transfer_rule]: - "((A ===> B ===> op =) ===> set_rel A ===> set_rel B ===> op =) - set_rel set_rel" - unfolding fun_rel_def set_rel_def by fast +lemma rel_set_transfer [transfer_rule]: + "((A ===> B ===> op =) ===> rel_set A ===> rel_set B ===> op =) + rel_set rel_set" + unfolding fun_rel_def rel_set_def by fast lemma SUPR_parametric [transfer_rule]: - "(set_rel R ===> (R ===> op =) ===> op =) SUPR (SUPR :: _ \ _ \ _::complete_lattice)" + "(rel_set R ===> (R ===> op =) ===> op =) SUPR (SUPR :: _ \ _ \ _::complete_lattice)" proof(rule fun_relI)+ fix A B f and g :: "'b \ 'c" - assume AB: "set_rel R A B" + assume AB: "rel_set R A B" and fg: "(R ===> op =) f g" show "SUPR A f = SUPR B g" - by(rule SUPR_eq)(auto 4 4 dest: set_relD1[OF AB] set_relD2[OF AB] fun_relD[OF fg] intro: rev_bexI) + by(rule SUPR_eq)(auto 4 4 dest: rel_setD1[OF AB] rel_setD2[OF AB] fun_relD[OF fg] intro: rev_bexI) qed lemma bind_transfer [transfer_rule]: - "(set_rel A ===> (A ===> set_rel B) ===> set_rel B) Set.bind Set.bind" + "(rel_set A ===> (A ===> rel_set B) ===> rel_set B) Set.bind Set.bind" unfolding bind_UNION[abs_def] by transfer_prover subsubsection {* Rules requiring bi-unique, bi-total or right-total relations *} lemma member_transfer [transfer_rule]: assumes "bi_unique A" - shows "(A ===> set_rel A ===> op =) (op \) (op \)" - using assms unfolding fun_rel_def set_rel_def bi_unique_def by fast + shows "(A ===> rel_set A ===> op =) (op \) (op \)" + using assms unfolding fun_rel_def rel_set_def bi_unique_def by fast lemma right_total_Collect_transfer[transfer_rule]: assumes "right_total A" - shows "((A ===> op =) ===> set_rel A) (\P. Collect (\x. P x \ Domainp A x)) Collect" - using assms unfolding right_total_def set_rel_def fun_rel_def Domainp_iff by fast + shows "((A ===> op =) ===> rel_set A) (\P. Collect (\x. P x \ Domainp A x)) Collect" + using assms unfolding right_total_def rel_set_def fun_rel_def Domainp_iff by fast lemma Collect_transfer [transfer_rule]: assumes "bi_total A" - shows "((A ===> op =) ===> set_rel A) Collect Collect" - using assms unfolding fun_rel_def set_rel_def bi_total_def by fast + shows "((A ===> op =) ===> rel_set A) Collect Collect" + using assms unfolding fun_rel_def rel_set_def bi_total_def by fast lemma inter_transfer [transfer_rule]: assumes "bi_unique A" - shows "(set_rel A ===> set_rel A ===> set_rel A) inter inter" - using assms unfolding fun_rel_def set_rel_def bi_unique_def by fast + shows "(rel_set A ===> rel_set A ===> rel_set A) inter inter" + using assms unfolding fun_rel_def rel_set_def bi_unique_def by fast lemma Diff_transfer [transfer_rule]: assumes "bi_unique A" - shows "(set_rel A ===> set_rel A ===> set_rel A) (op -) (op -)" - using assms unfolding fun_rel_def set_rel_def bi_unique_def + shows "(rel_set A ===> rel_set A ===> rel_set A) (op -) (op -)" + using assms unfolding fun_rel_def rel_set_def bi_unique_def unfolding Ball_def Bex_def Diff_eq by (safe, simp, metis, simp, metis) lemma subset_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" - shows "(set_rel A ===> set_rel A ===> op =) (op \) (op \)" + shows "(rel_set A ===> rel_set A ===> op =) (op \) (op \)" unfolding subset_eq [abs_def] by transfer_prover lemma right_total_UNIV_transfer[transfer_rule]: assumes "right_total A" - shows "(set_rel A) (Collect (Domainp A)) UNIV" - using assms unfolding right_total_def set_rel_def Domainp_iff by blast + shows "(rel_set A) (Collect (Domainp A)) UNIV" + using assms unfolding right_total_def rel_set_def Domainp_iff by blast lemma UNIV_transfer [transfer_rule]: assumes "bi_total A" - shows "(set_rel A) UNIV UNIV" - using assms unfolding set_rel_def bi_total_def by simp + shows "(rel_set A) UNIV UNIV" + using assms unfolding rel_set_def bi_total_def by simp lemma right_total_Compl_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "right_total A" - shows "(set_rel A ===> set_rel A) (\S. uminus S \ Collect (Domainp A)) uminus" + shows "(rel_set A ===> rel_set A) (\S. uminus S \ Collect (Domainp A)) uminus" unfolding Compl_eq [abs_def] by (subst Collect_conj_eq[symmetric]) transfer_prover lemma Compl_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "bi_total A" - shows "(set_rel A ===> set_rel A) uminus uminus" + shows "(rel_set A ===> rel_set A) uminus uminus" unfolding Compl_eq [abs_def] by transfer_prover lemma right_total_Inter_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "right_total A" - shows "(set_rel (set_rel A) ===> set_rel A) (\S. Inter S \ Collect (Domainp A)) Inter" + shows "(rel_set (rel_set A) ===> rel_set A) (\S. Inter S \ Collect (Domainp A)) Inter" unfolding Inter_eq[abs_def] by (subst Collect_conj_eq[symmetric]) transfer_prover lemma Inter_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" and [transfer_rule]: "bi_total A" - shows "(set_rel (set_rel A) ===> set_rel A) Inter Inter" + shows "(rel_set (rel_set A) ===> rel_set A) Inter Inter" unfolding Inter_eq [abs_def] by transfer_prover lemma filter_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" - shows "((A ===> op=) ===> set_rel A ===> set_rel A) Set.filter Set.filter" - unfolding Set.filter_def[abs_def] fun_rel_def set_rel_def by blast + shows "((A ===> op=) ===> rel_set A ===> rel_set A) Set.filter Set.filter" + unfolding Set.filter_def[abs_def] fun_rel_def rel_set_def by blast -lemma bi_unique_set_rel_lemma: - assumes "bi_unique R" and "set_rel R X Y" +lemma bi_unique_rel_set_lemma: + assumes "bi_unique R" and "rel_set R X Y" obtains f where "Y = image f X" and "inj_on f X" and "\x\X. R x (f x)" proof let ?f = "\x. THE y. R x y" from assms show f: "\x\X. R x (?f x)" - apply (clarsimp simp add: set_rel_def) + apply (clarsimp simp add: rel_set_def) apply (drule (1) bspec, clarify) apply (rule theI2, assumption) apply (simp add: bi_unique_def) @@ -248,13 +248,13 @@ done from assms show "Y = image ?f X" apply safe - apply (clarsimp simp add: set_rel_def) + apply (clarsimp simp add: rel_set_def) apply (drule (1) bspec, clarify) apply (rule image_eqI) apply (rule the_equality [symmetric], assumption) apply (simp add: bi_unique_def) apply assumption - apply (clarsimp simp add: set_rel_def) + apply (clarsimp simp add: rel_set_def) apply (frule (1) bspec, clarify) apply (rule theI2, assumption) apply (clarsimp simp add: bi_unique_def) @@ -269,41 +269,41 @@ qed lemma finite_transfer [transfer_rule]: - "bi_unique A \ (set_rel A ===> op =) finite finite" - by (rule fun_relI, erule (1) bi_unique_set_rel_lemma, + "bi_unique A \ (rel_set A ===> op =) finite finite" + by (rule fun_relI, erule (1) bi_unique_rel_set_lemma, auto dest: finite_imageD) lemma card_transfer [transfer_rule]: - "bi_unique A \ (set_rel A ===> op =) card card" - by (rule fun_relI, erule (1) bi_unique_set_rel_lemma, simp add: card_image) + "bi_unique A \ (rel_set A ===> op =) card card" + by (rule fun_relI, erule (1) bi_unique_rel_set_lemma, simp add: card_image) lemma vimage_parametric [transfer_rule]: assumes [transfer_rule]: "bi_total A" "bi_unique B" - shows "((A ===> B) ===> set_rel B ===> set_rel A) vimage vimage" + shows "((A ===> B) ===> rel_set B ===> rel_set A) vimage vimage" unfolding vimage_def[abs_def] by transfer_prover lemma setsum_parametric [transfer_rule]: assumes "bi_unique A" - shows "((A ===> op =) ===> set_rel A ===> op =) setsum setsum" + shows "((A ===> op =) ===> rel_set A ===> op =) setsum setsum" proof(rule fun_relI)+ fix f :: "'a \ 'c" and g S T assume fg: "(A ===> op =) f g" - and ST: "set_rel A S T" + and ST: "rel_set A S T" show "setsum f S = setsum g T" proof(rule setsum_reindex_cong) let ?f = "\t. THE s. A s t" show "S = ?f ` T" - by(blast dest: set_relD1[OF ST] set_relD2[OF ST] bi_uniqueDl[OF assms] + by(blast dest: rel_setD1[OF ST] rel_setD2[OF ST] bi_uniqueDl[OF assms] intro: rev_image_eqI the_equality[symmetric] subst[rotated, where P="\x. x \ S"]) show "inj_on ?f T" proof(rule inj_onI) fix t1 t2 assume "t1 \ T" "t2 \ T" "?f t1 = ?f t2" - from ST `t1 \ T` obtain s1 where "A s1 t1" "s1 \ S" by(auto dest: set_relD2) + from ST `t1 \ T` obtain s1 where "A s1 t1" "s1 \ S" by(auto dest: rel_setD2) hence "?f t1 = s1" by(auto dest: bi_uniqueDl[OF assms]) moreover - from ST `t2 \ T` obtain s2 where "A s2 t2" "s2 \ S" by(auto dest: set_relD2) + from ST `t2 \ T` obtain s2 where "A s2 t2" "s2 \ S" by(auto dest: rel_setD2) hence "?f t2 = s2" by(auto dest: bi_uniqueDl[OF assms]) ultimately have "s1 = s2" using `?f t1 = ?f t2` by simp with `A s1 t1` `A s2 t2` show "t1 = t2" by(auto dest: bi_uniqueDr[OF assms]) @@ -311,7 +311,7 @@ fix t assume "t \ T" - with ST obtain s where "A s t" "s \ S" by(auto dest: set_relD2) + with ST obtain s where "A s t" "s \ S" by(auto dest: rel_setD2) hence "?f t = s" by(auto dest: bi_uniqueDl[OF assms]) moreover from fg `A s t` have "f s = g t" by(rule fun_relD) ultimately show "g t = f (?f t)" by simp diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/List.thy --- a/src/HOL/List.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/List.thy Thu Mar 06 14:57:14 2014 +0100 @@ -6734,7 +6734,7 @@ by (rule fun_relI, erule list_all2_induct, auto) lemma set_transfer [transfer_rule]: - "(list_all2 A ===> set_rel A) set set" + "(list_all2 A ===> rel_set A) set set" unfolding set_rec[abs_def] by transfer_prover lemma map_rec: "map f xs = rec_list Nil (%x _ y. Cons (f x) y) xs" @@ -6864,7 +6864,7 @@ done lemma sublist_transfer [transfer_rule]: - "(list_all2 A ===> set_rel (op =) ===> list_all2 A) sublist sublist" + "(list_all2 A ===> rel_set (op =) ===> list_all2 A) sublist sublist" unfolding sublist_def [abs_def] by transfer_prover lemma partition_transfer [transfer_rule]: @@ -6873,25 +6873,25 @@ unfolding partition_def by transfer_prover lemma lists_transfer [transfer_rule]: - "(set_rel A ===> set_rel (list_all2 A)) lists lists" - apply (rule fun_relI, rule set_relI) + "(rel_set A ===> rel_set (list_all2 A)) lists lists" + apply (rule fun_relI, rule rel_setI) apply (erule lists.induct, simp) - apply (simp only: set_rel_def list_all2_Cons1, metis lists.Cons) + apply (simp only: rel_set_def list_all2_Cons1, metis lists.Cons) apply (erule lists.induct, simp) - apply (simp only: set_rel_def list_all2_Cons2, metis lists.Cons) + apply (simp only: rel_set_def list_all2_Cons2, metis lists.Cons) done lemma set_Cons_transfer [transfer_rule]: - "(set_rel A ===> set_rel (list_all2 A) ===> set_rel (list_all2 A)) + "(rel_set A ===> rel_set (list_all2 A) ===> rel_set (list_all2 A)) set_Cons set_Cons" - unfolding fun_rel_def set_rel_def set_Cons_def + unfolding fun_rel_def rel_set_def set_Cons_def apply safe apply (simp add: list_all2_Cons1, fast) apply (simp add: list_all2_Cons2, fast) done lemma listset_transfer [transfer_rule]: - "(list_all2 (set_rel A) ===> set_rel (list_all2 A)) listset listset" + "(list_all2 (rel_set A) ===> rel_set (list_all2 A)) listset listset" unfolding listset_def by transfer_prover lemma null_transfer [transfer_rule]: diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/Topological_Spaces.thy --- a/src/HOL/Topological_Spaces.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/Topological_Spaces.thy Thu Mar 06 14:57:14 2014 +0100 @@ -2497,19 +2497,19 @@ by(fastforce simp add: filter_rel_eventually[abs_def] eventually_sup dest: fun_relD) lemma Sup_filter_parametric [transfer_rule]: - "(set_rel (filter_rel A) ===> filter_rel A) Sup Sup" + "(rel_set (filter_rel A) ===> filter_rel A) Sup Sup" proof(rule fun_relI) fix S T - assume [transfer_rule]: "set_rel (filter_rel A) S T" + assume [transfer_rule]: "rel_set (filter_rel A) S T" show "filter_rel A (Sup S) (Sup T)" by(simp add: filter_rel_eventually eventually_Sup) transfer_prover qed lemma principal_parametric [transfer_rule]: - "(set_rel A ===> filter_rel A) principal principal" + "(rel_set A ===> filter_rel A) principal principal" proof(rule fun_relI) fix S S' - assume [transfer_rule]: "set_rel A S S'" + assume [transfer_rule]: "rel_set A S S'" show "filter_rel A (principal S) (principal S')" by(simp add: filter_rel_eventually eventually_principal) transfer_prover qed @@ -2532,7 +2532,7 @@ begin lemma Inf_filter_parametric [transfer_rule]: - "(set_rel (filter_rel A) ===> filter_rel A) Inf Inf" + "(rel_set (filter_rel A) ===> filter_rel A) Inf Inf" unfolding Inf_filter_def[abs_def] by transfer_prover lemma inf_filter_parametric [transfer_rule]: diff -r 18e52e8c6300 -r f20d1db5aa3c src/HOL/ex/Transfer_Int_Nat.thy --- a/src/HOL/ex/Transfer_Int_Nat.thy Thu Mar 06 14:25:55 2014 +0100 +++ b/src/HOL/ex/Transfer_Int_Nat.thy Thu Mar 06 14:57:14 2014 +0100 @@ -96,19 +96,19 @@ unfolding fun_rel_def ZN_def by (simp add: transfer_int_nat_gcd) lemma ZN_atMost [transfer_rule]: - "(ZN ===> set_rel ZN) (atLeastAtMost 0) atMost" - unfolding fun_rel_def ZN_def set_rel_def + "(ZN ===> rel_set ZN) (atLeastAtMost 0) atMost" + unfolding fun_rel_def ZN_def rel_set_def by (clarsimp simp add: Bex_def, arith) lemma ZN_atLeastAtMost [transfer_rule]: - "(ZN ===> ZN ===> set_rel ZN) atLeastAtMost atLeastAtMost" - unfolding fun_rel_def ZN_def set_rel_def + "(ZN ===> ZN ===> rel_set ZN) atLeastAtMost atLeastAtMost" + unfolding fun_rel_def ZN_def rel_set_def by (clarsimp simp add: Bex_def, arith) lemma ZN_setsum [transfer_rule]: - "bi_unique A \ ((A ===> ZN) ===> set_rel A ===> ZN) setsum setsum" + "bi_unique A \ ((A ===> ZN) ===> rel_set A ===> ZN) setsum setsum" apply (intro fun_relI) - apply (erule (1) bi_unique_set_rel_lemma) + apply (erule (1) bi_unique_rel_set_lemma) apply (simp add: setsum.reindex int_setsum ZN_def fun_rel_def) apply (rule setsum_cong2, simp) done