diff -r 295772dfe62b -r f3cbda066c3a QuotMain.thy --- a/QuotMain.thy Tue Oct 06 11:56:23 2009 +0200 +++ b/QuotMain.thy Tue Oct 06 15:11:30 2009 +0200 @@ -143,34 +143,34 @@ section {* type definition for the quotient type *} ML {* -(* constructs the term \(c::ty \ bool). \x. c = rel x *) -fun typedef_term rel ty lthy = +(* constructs the term \(c::rty \ bool). \x. c = rel x *) +fun typedef_term rel rty lthy = let - val [x, c] = [("x", ty), ("c", ty --> @{typ bool})] + val [x, c] = [("x", rty), ("c", rty --> @{typ bool})] |> Variable.variant_frees lthy [rel] |> map Free in lambda c - (HOLogic.exists_const ty $ + (HOLogic.exists_const rty $ lambda x (HOLogic.mk_eq (c, (rel $ x)))) end *} ML {* (* makes the new type definitions and proves non-emptyness*) -fun typedef_make (qty_name, mx, rel, ty) lthy = +fun typedef_make (qty_name, mx, rel, rty) lthy = let val typedef_tac = EVERY1 [rewrite_goal_tac @{thms mem_def}, rtac @{thm exI}, rtac @{thm exI}, rtac @{thm refl}] - val tfrees = map fst (Term.add_tfreesT ty []) + val tfrees = map fst (Term.add_tfreesT rty []) in LocalTheory.theory_result (Typedef.add_typedef false NONE (qty_name, tfrees, mx) - (typedef_term rel ty lthy) + (typedef_term rel rty lthy) NONE typedef_tac) lthy end *} @@ -202,13 +202,13 @@ val quot_type_const = Const (@{const_name "QUOT_TYPE"}, dummyT) val goal = HOLogic.mk_Trueprop (quot_type_const $ rel $ abs $ rep) |> Syntax.check_term lthy - val _ = goal |> Syntax.string_of_term lthy |> tracing in Goal.prove lthy [] [] goal (K (typedef_quot_type_tac equiv_thm typedef_info)) end +*} - +ML {* (* proves the quotient theorem *) fun typedef_quotient_thm (rel, abs, rep, abs_def, rep_def, quot_type_thm) lthy = let @@ -255,10 +255,10 @@ *} ML {* -fun typedef_main (qty_name, mx, rel, ty, equiv_thm) lthy = +fun typedef_main (qty_name, mx, rel, rty, equiv_thm) lthy = let (* generates typedef *) - val ((_, typedef_info), lthy1) = typedef_make (qty_name, mx, rel, ty) lthy + val ((_, typedef_info), lthy1) = typedef_make (qty_name, mx, rel, rty) lthy (* abs and rep functions *) val abs_ty = #abs_type typedef_info @@ -440,7 +440,7 @@ fun get_const absF = (Const ("QuotMain.ABS_" ^ qty_name, rty --> qty), (rty, qty)) | get_const repF = (Const ("QuotMain.REP_" ^ qty_name, qty --> rty), (qty, rty)) - fun mk_identity ty = Abs ("x", ty, Bound 0) + fun mk_identity ty = Abs ("", ty, Bound 0) in if ty = qty @@ -1048,26 +1048,26 @@ (*notation ( output) "prop" ("#_" [1000] 1000) *) notation ( output) "Trueprop" ("#_" [1000] 1000) -lemma atomize_eqv [atomize]: "(Trueprop A \ Trueprop B) \ (A \ B)" - (is "?rhs \ ?lhs") +lemma atomize_eqv[atomize]: + shows "(Trueprop A \ Trueprop B) \ (A \ B)" proof - assume "PROP ?lhs" then show "PROP ?rhs" by unfold + assume "A \ B" + then show "Trueprop A \ Trueprop B" by unfold next - assume *: "PROP ?rhs" + assume *: "Trueprop A \ Trueprop B" have "A = B" proof (cases A) case True - with * have B by unfold - with `A` show ?thesis by simp + have "A" by fact + then show "A = B" using * by simp next case False - with * have "~ B" by auto - with `~ A` show ?thesis by simp + have "\A" by fact + then show "A = B" using * by auto qed - then show "PROP ?lhs" by (rule eq_reflection) + then show "A \ B" by (rule eq_reflection) qed - prove {* (Thm.term_of cgoal2) *} apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} ) apply (atomize(full))