quotient_def.ML
changeset 279 b2fd070c8833
parent 277 37636f2b1c19
child 280 0e89332f7625
--- a/quotient_def.ML	Wed Nov 04 11:59:48 2009 +0100
+++ b/quotient_def.ML	Wed Nov 04 12:07:22 2009 +0100
@@ -15,6 +15,7 @@
 structure Quotient_Def: QUOTIENT_DEF =
 struct
 
+(* wrapper for define *)
 fun define name mx attr rhs lthy =
 let
   val ((rhs, (_ , thm)), lthy') =
@@ -120,6 +121,8 @@
   | diffs _ _ = error "Unequal length of type arguments"
 
 
+(* sanity check that the calculated quotient environment
+   matches with the stored quotient environment. *)
 fun error_msg lthy (qty, rty) =
 let 
   val qtystr = quote (Syntax.string_of_typ lthy qty)
@@ -130,21 +133,21 @@
 
 fun sanity_chk lthy qenv =
 let
-   val qenv' = Quotient_Info.mk_qenv lthy
-   val thy = ProofContext.theory_of lthy
+  val qenv' = Quotient_Info.mk_qenv lthy
+  val thy = ProofContext.theory_of lthy
 
-   fun is_inst thy (qty, rty) (qty', rty') =
-   if Sign.typ_instance thy (qty, qty')
-   then let
-          val inst = Sign.typ_match thy (qty', qty) Vartab.empty
-        in
-          rty = Envir.subst_type inst rty'
-        end
-   else false
+  fun is_inst thy (qty, rty) (qty', rty') =
+  if Sign.typ_instance thy (qty, qty')
+  then let
+         val inst = Sign.typ_match thy (qty', qty) Vartab.empty
+       in
+         rty = Envir.subst_type inst rty'       
+       end
+  else false
 
-   fun chk_inst (qty, rty) = 
-     if exists (is_inst thy (qty, rty)) qenv' then true
-     else error_msg lthy (qty, rty)
+  fun chk_inst (qty, rty) = 
+    if exists (is_inst thy (qty, rty)) qenv' then true
+    else error_msg lthy (qty, rty)
 in
   forall chk_inst qenv
 end
@@ -162,13 +165,6 @@
   make_def bind rhs qty mx attr qenv lthy 
 end
 
-
-val quotdef_parser =
-  (OuterParse.binding --
-    (OuterParse.$$$ "::" |-- OuterParse.!!! (OuterParse.typ -- 
-      OuterParse.opt_mixfix' --| OuterParse.where_)) >> OuterParse.triple2) -- 
-       (SpecParse.opt_thm_name ":" -- OuterParse.prop)
-
 fun quotdef_cmd ((bind, qtystr, mx), (attr, propstr)) lthy = 
 let
   val qty  = (Syntax.check_typ lthy o Syntax.parse_typ lthy) qtystr
@@ -177,6 +173,13 @@
   quotdef ((bind, qty, mx), (attr, prop)) lthy |> snd
 end
 
+
+val quotdef_parser =
+  (OuterParse.binding --
+    (OuterParse.$$$ "::" |-- OuterParse.!!! (OuterParse.typ -- 
+      OuterParse.opt_mixfix' --| OuterParse.where_)) >> OuterParse.triple2) -- 
+       (SpecParse.opt_thm_name ":" -- OuterParse.prop)
+
 val _ = OuterSyntax.local_theory "quotient_def" "lifted definition of constants"
   OuterKeyword.thy_decl (quotdef_parser >> quotdef_cmd)