Attic/Quot/quotient_typ.ML
changeset 1438 61671de8a545
parent 1437 45fb38a2e3f7
child 1460 0fd03936dedb
--- 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 *)