diff -r a6f3e1b08494 -r b6873d123f9b Attic/Quot/Examples/Pair.thy --- a/Attic/Quot/Examples/Pair.thy Sat May 12 21:05:59 2012 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,120 +0,0 @@ -theory Pair -imports Quotient_Product "../../../Nominal/FSet" -begin - -fun alpha :: "('a \ 'a) \ ('a \ 'a) \ bool" (infix "\" 100) -where - "(a, b) \ (c, d) = (a = c \ b = d \ a = d \ b = c)" - -lemma alpha_refl: - shows "z \ z" - by (case_tac z, auto) - -lemma alpha_equivp: - shows "equivp op \" - unfolding equivp_reflp_symp_transp reflp_def symp_def transp_def - by auto - -quotient_type - 'a pair_set = "'a \ 'a" / alpha - by (auto intro: alpha_equivp) - -quotient_definition - "Two :: 'a \ 'a \ 'a pair_set" -is - "Pair :: 'a \ 'a \ ('a \ 'a)" - -fun - memb_both_lists -where - "memb_both_lists a (b, c) = (memb a b \ memb a c)" - -quotient_definition - "mem_fsets :: 'a \ 'a fset pair_set \ bool" -is memb_both_lists - -lemma prod_hlp: "prod_fun abs_fset abs_fset (prod_fun rep_fset rep_fset x) = x" - by (cases x, auto simp add: Quotient_abs_rep[OF Quotient_fset]) - -lemma prod_hlp2: - "prod_rel list_eq list_eq (prod_fun rep_fset rep_fset z) (prod_fun rep_fset rep_fset z)" - by (cases z, simp) - -lemma [quot_thm]: - shows "Quotient ((op \) OOO (prod_rel list_eq list_eq)) - (abs_pair_set \ prod_fun abs_fset abs_fset) - (prod_fun rep_fset rep_fset \ rep_pair_set)" - unfolding Quotient_def comp_def - apply (intro conjI allI) - apply (simp add: prod_hlp Quotient_abs_rep[OF Quotient_pair_set]) - apply rule - apply (rule alpha_refl) - apply rule - apply (rule prod_hlp2) - apply (rule alpha_refl) - apply (intro iffI conjI) - sorry - -lemma [quot_respect]: - "(op = ===> op \ OOO prod_rel list_eq list_eq ===> op =) memb_both_lists memb_both_lists" - apply (intro fun_relI) - apply clarify - apply (simp only: memb_both_lists.simps) - sorry - -lemma [quot_respect]: - "(list_eq ===> list_eq ===> op \ OOO prod_rel list_eq list_eq) Pair Pair" - apply (intro fun_relI) - apply rule - apply (rule alpha_refl) - apply rule - prefer 2 - apply (rule alpha_refl) - apply simp - done - -lemma [quot_preserve]: - "(rep_fset ---> rep_fset ---> abs_pair_set \ prod_fun abs_fset abs_fset) Pair = Two" - by (simp add: expand_fun_eq Quotient_abs_rep[OF Quotient_fset] Two_def) - -lemma "mem_fsets a (Two b c) = (a |\| b \ a |\| c)" - by (lifting memb_both_lists.simps) - -(* Doing it in 2 steps *) - -quotient_definition - "mem_lists :: 'a \ 'a list pair_set \ bool" -is memb_both_lists - -lemma [quot_respect]: "(op = ===> op \ ===> op =) memb_both_lists memb_both_lists" - by auto - -lemma [quot_respect]: "(op = ===> op = ===> op \) Pair Pair" - by auto - -lemma step1: "mem_lists a (Two b c) = (memb a b \ memb a c)" - by (lifting memb_both_lists.simps) - -lemma step2: "mem_fsets a (Two b c) = (a |\| b \ a |\| c)" - (* apply (lifting step1) ??? *) - oops - -(* Doing it in 2 steps the other way *) - -quotient_definition - "memb_both_fsets :: 'a \ 'a fset \ 'a fset \ bool" -is memb_both_lists - -lemma [quot_respect]: - "(op = ===> prod_rel list_eq list_eq ===> op =) memb_both_lists memb_both_lists" - by (auto simp add: memb_def[symmetric]) - -lemma bla: "memb_both_fsets a (b, c) = (a |\| b \ a |\| c)" - by (lifting memb_both_lists.simps) - -lemma step2: "mem_fsets a (Two b c) = (a |\| b \ a |\| c)" - (* ??? *) - oops - -end -