diff -r 2ac5af6eb8a8 -r fd9c98ead9a9 src/HOL/Library/Quotient_Option.thy --- a/src/HOL/Library/Quotient_Option.thy Tue Nov 30 15:58:09 2010 +0100 +++ b/src/HOL/Library/Quotient_Option.thy Tue Nov 30 15:58:09 2010 +0100 @@ -18,64 +18,73 @@ declare [[map option = (Option.map, option_rel)]] -text {* should probably be in Option.thy *} -lemma split_option_all: - shows "(\x. P x) \ P None \ (\a. P (Some a))" - apply(auto) - apply(case_tac x) - apply(simp_all) +lemma option_rel_unfold: + "option_rel R x y = (case (x, y) of (None, None) \ True + | (Some x, Some y) \ R x y + | _ \ False)" + by (cases x) (cases y, simp_all)+ + +lemma option_rel_map1: + "option_rel R (Option.map f x) y \ option_rel (\x. R (f x)) x y" + by (simp add: option_rel_unfold split: option.split) + +lemma option_rel_map2: + "option_rel R x (Option.map f y) \ option_rel (\x y. R x (f y)) x y" + by (simp add: option_rel_unfold split: option.split) + +lemma option_map_id [id_simps]: + "Option.map id = id" + by (simp add: id_def Option.map.identity fun_eq_iff) + +lemma option_rel_eq [id_simps]: + "option_rel (op =) = (op =)" + by (simp add: option_rel_unfold fun_eq_iff split: option.split) + +lemma option_reflp: + "reflp R \ reflp (option_rel R)" + by (auto simp add: option_rel_unfold split: option.splits intro!: reflpI elim: reflpE) + +lemma option_symp: + "symp R \ symp (option_rel R)" + by (auto simp add: option_rel_unfold split: option.splits intro!: sympI elim: sympE) + +lemma option_transp: + "transp R \ transp (option_rel R)" + by (auto simp add: option_rel_unfold split: option.splits intro!: transpI elim: transpE) + +lemma option_equivp [quot_equiv]: + "equivp R \ equivp (option_rel R)" + by (blast intro: equivpI option_reflp option_symp option_transp elim: equivpE) + +lemma option_quotient [quot_thm]: + assumes "Quotient R Abs Rep" + shows "Quotient (option_rel R) (Option.map Abs) (Option.map Rep)" + apply (rule QuotientI) + apply (simp_all add: Option.map.compositionality Option.map.identity option_rel_eq option_rel_map1 option_rel_map2 Quotient_abs_rep [OF assms] Quotient_rel_rep [OF assms]) + using Quotient_rel [OF assms] + apply (simp add: option_rel_unfold split: option.split) done -lemma option_quotient[quot_thm]: - assumes q: "Quotient R Abs Rep" - shows "Quotient (option_rel R) (Option.map Abs) (Option.map Rep)" - unfolding Quotient_def - apply(simp add: split_option_all) - apply(simp add: Quotient_abs_rep[OF q] Quotient_rel_rep[OF q]) - using q - unfolding Quotient_def - apply(blast) - done - -lemma option_equivp[quot_equiv]: - assumes a: "equivp R" - shows "equivp (option_rel R)" - apply(rule equivpI) - unfolding reflp_def symp_def transp_def - apply(simp_all add: split_option_all) - apply(blast intro: equivp_reflp[OF a]) - apply(blast intro: equivp_symp[OF a]) - apply(blast intro: equivp_transp[OF a]) - done - -lemma option_None_rsp[quot_respect]: +lemma option_None_rsp [quot_respect]: assumes q: "Quotient R Abs Rep" shows "option_rel R None None" by simp -lemma option_Some_rsp[quot_respect]: +lemma option_Some_rsp [quot_respect]: assumes q: "Quotient R Abs Rep" shows "(R ===> option_rel R) Some Some" by auto -lemma option_None_prs[quot_preserve]: +lemma option_None_prs [quot_preserve]: assumes q: "Quotient R Abs Rep" shows "Option.map Abs None = None" by simp -lemma option_Some_prs[quot_preserve]: +lemma option_Some_prs [quot_preserve]: assumes q: "Quotient R Abs Rep" shows "(Rep ---> Option.map Abs) Some = Some" apply(simp add: fun_eq_iff) apply(simp add: Quotient_abs_rep[OF q]) done -lemma option_map_id[id_simps]: - shows "Option.map id = id" - by (simp add: fun_eq_iff split_option_all) - -lemma option_rel_eq[id_simps]: - shows "option_rel (op =) = (op =)" - by (simp add: fun_eq_iff split_option_all) - end