diff -r 45fb38a2e3f7 -r 61671de8a545 Attic/Quot/quotient_typ.ML --- a/Attic/Quot/quotient_typ.ML Sun Mar 14 11:36:15 2010 +0100 +++ b/Attic/Quot/quotient_typ.ML Mon Mar 15 06:11:35 2010 +0100 @@ -7,6 +7,9 @@ signature QUOTIENT_TYPE = sig + val add_quotient_type: ((string list * binding * mixfix) * (typ * term)) * thm + -> Proof.context -> (thm * thm) * local_theory + val quotient_type: ((string list * binding * mixfix) * (typ * term)) list -> Proof.context -> Proof.state @@ -69,12 +72,13 @@ fun typedef_make (vs, qty_name, mx, rel, rty) lthy = let val typedef_tac = - EVERY1 (map rtac [@{thm exI}, mem_def2, @{thm exI}, @{thm refl}]) + EVERY1 (map rtac [@{thm exI}, mem_def2, @{thm exI}, @{thm refl}]) in - Typedef.add_typedef false NONE - (qty_name, vs, mx) - (typedef_term rel rty lthy) - NONE typedef_tac lthy + Local_Theory.theory_result + (Typedef.add_typedef_global false NONE + (qty_name, vs, mx) + (typedef_term rel rty lthy) + NONE typedef_tac) lthy end @@ -127,7 +131,7 @@ (* main function for constructing a quotient type *) -fun mk_quotient_type (((vs, qty_name, mx), (rty, rel)), equiv_thm) lthy = +fun add_quotient_type (((vs, qty_name, mx), (rty, rel)), equiv_thm) lthy = let (* generates the typedef *) val ((qty_full_name, typedef_info), lthy1) = typedef_make (vs, qty_name, mx, rel, rty) lthy @@ -263,7 +267,7 @@ val goals = map (mk_goal o snd) quot_list fun after_qed thms lthy = - fold_map mk_quotient_type (quot_list ~~ thms) lthy |> snd + fold_map add_quotient_type (quot_list ~~ thms) lthy |> snd in theorem after_qed goals lthy end @@ -272,14 +276,13 @@ let fun parse_spec ((((vs, qty_name), mx), rty_str), rel_str) lthy = let - (* new parsing with proper declaration *) val rty = Syntax.read_typ lthy rty_str val lthy1 = Variable.declare_typ rty lthy val rel = Syntax.parse_term lthy1 rel_str |> Syntax.type_constraint (rty --> rty --> @{typ bool}) |> Syntax.check_term lthy1 - val lthy2 = Variable.declare_term rel lthy1 + val lthy2 = Variable.declare_term rel lthy1 in (((vs, qty_name, mx), (rty, rel)), lthy2) end @@ -289,20 +292,17 @@ quotient_type spec' lthy' end -local - structure P = OuterParse; -in - val quotspec_parser = - P.and_list1 ((P.type_args -- P.binding) -- P.opt_infix -- - (P.$$$ "=" |-- P.typ) -- (P.$$$ "/" |-- P.term)) -end + OuterParse.and_list1 + ((OuterParse.type_args -- OuterParse.binding) -- + OuterParse.opt_mixfix -- (OuterParse.$$$ "=" |-- OuterParse.typ) -- + (OuterParse.$$$ "/" |-- OuterParse.term)) val _ = OuterKeyword.keyword "/" val _ = - OuterSyntax.local_theory_to_proof "quotient_type" - "quotient type definitions (require equivalence proofs)" - OuterKeyword.thy_goal (quotspec_parser >> quotient_type_cmd) + OuterSyntax.local_theory_to_proof "quotient_type" + "quotient type definitions (require equivalence proofs)" + OuterKeyword.thy_goal (quotspec_parser >> quotient_type_cmd) end; (* structure *)