proper declaration of types and terms during parsing (removes the varifyT when storing data)
authorChristian Urban <urbanc@in.tum.de>
Tue, 09 Feb 2010 19:08:08 +0100
changeset 1110 1e5dee9e6ae2
parent 1109 86093c201bac
child 1111 ee276c9f12f0
proper declaration of types and terms during parsing (removes the varifyT when storing data)
Quot/quotient_typ.ML
--- a/Quot/quotient_typ.ML	Tue Feb 09 17:26:28 2010 +0100
+++ b/Quot/quotient_typ.ML	Tue Feb 09 19:08:08 2010 +0100
@@ -163,10 +163,8 @@
   val equiv_thm_name = Binding.suffix_name "_equivp" qty_name
 
   (* storing the quot-info *)
-  (* FIXME: VarifyT should not be used - at the moment it allows matching against the types. *)
   fun qinfo phi = transform_quotdata phi
-    {qtyp = Logic.varifyT Abs_ty, rtyp = Logic.varifyT rty,
-     equiv_rel = map_types Logic.varifyT rel, equiv_thm = equiv_thm}
+    {qtyp = Abs_ty, rtyp = rty, equiv_rel = rel, equiv_thm = equiv_thm}
   val lthy4 = Local_Theory.declaration true
     (fn phi => quotdata_update_gen qty_full_name (qinfo phi)) lthy3
 in
@@ -273,17 +271,26 @@
            
 fun quotient_type_cmd specs lthy = 
 let
-  fun parse_spec ((((vs, qty_name), mx), rty_str), rel_str) =
+  fun parse_spec ((((vs, qty_name), mx), rty_str), rel_str) lthy =
   let
-    (*val rty = Syntax.read_typ lthy rty_str*)
-    
+    (* new parsing with proper declaration *)
     val rty = Syntax.read_typ lthy rty_str
-    val rel = Syntax.read_term lthy rel_str 
+    val lthy1 = Variable.declare_typ rty lthy
+    val pre_rel = Syntax.parse_term lthy1 rel_str
+    val pre_rel' = Syntax.type_constraint (rty --> rty --> @{typ bool}) pre_rel
+    val rel = Syntax.check_term lthy1 pre_rel'   
+    val lthy2 = Variable.declare_term rel lthy1
+   
+    (* old parsing *)
+    (* val rty = Syntax.read_typ lthy rty_str
+       val rel = Syntax.read_term lthy rel_str *) 
   in
-    ((vs, qty_name, mx), (rty, rel))
+    (((vs, qty_name, mx), (rty, rel)), lthy2)
   end
+
+  val (spec', lthy') = fold_map parse_spec specs lthy
 in
-  quotient_type (map parse_spec specs) lthy
+  quotient_type spec' lthy'
 end
 
 val quotspec_parser =