--- a/IntEx.thy Sat Nov 21 14:45:25 2009 +0100
+++ b/IntEx.thy Sat Nov 21 23:23:01 2009 +0100
@@ -119,6 +119,8 @@
where
"SIGN i = (if i = ZERO then ZERO else if (LESS ZERO i) then ONE else (NEG ONE))"
+
+
ML {* print_qconstinfo @{context} *}
ML {* print_qconstinfo @{context} *}
--- a/quotient.ML Sat Nov 21 14:45:25 2009 +0100
+++ b/quotient.ML Sat Nov 21 23:23:01 2009 +0100
@@ -39,8 +39,8 @@
end
-(* definition of the quotient type *)
-(***********************************)
+(* definition of quotient types *)
+(********************************)
(* constructs the term lambda (c::rty => bool). EX (x::rty). c = rel x *)
fun typedef_term rel rty lthy =
--- a/quotient_def.ML Sat Nov 21 14:45:25 2009 +0100
+++ b/quotient_def.ML Sat Nov 21 23:23:01 2009 +0100
@@ -24,11 +24,6 @@
((rhs, thm), lthy')
end
-(* calculates the aggregate abs and rep functions for a given type;
- repF is for constants' arguments; absF is for constants;
- function types need to be treated specially, since repF and absF
- change *)
-
datatype flag = absF | repF
fun negF absF = repF
@@ -72,6 +67,12 @@
| repF => Const (Sign.full_bname thy ("REP_" ^ qty_name), dummyT)
end
+
+(* calculates the aggregate abs and rep functions for a given type;
+ repF is for constants' arguments; absF is for constants;
+ function types need to be treated specially, since repF and absF
+ change *)
+
fun get_fun flag lthy (rty, qty) =
case (rty, qty) of
(Type ("fun", [ty1, ty2]), Type ("fun", [ty1', ty2'])) =>
@@ -96,7 +97,7 @@
| (TVar _, TVar _) => ty_lift_error2 lthy rty qty
| _ => ty_lift_error1 lthy rty qty
-fun make_def nconst_bname qty mx attr rhs lthy =
+fun make_def qconst_bname qty mx attr rhs lthy =
let
val rty = fastype_of rhs
val (arg_rtys, res_rty) = strip_type rty
@@ -111,12 +112,12 @@
val absrep_trm = (fold_rev mk_fun_map rep_fns abs_fn $ rhs)
|> Syntax.check_term lthy
- val ((trm, thm), lthy') = define nconst_bname mx attr absrep_trm lthy
+ val ((trm, thm), lthy') = define qconst_bname mx attr absrep_trm lthy
- val nconst_str = Binding.name_of nconst_bname
+ val qconst_str = Binding.name_of qconst_bname
fun qcinfo phi = qconsts_transfer phi {qconst = trm, rconst = rhs}
val lthy'' = Local_Theory.declaration true
- (fn phi => qconsts_update_gen nconst_str (qcinfo phi)) lthy'
+ (fn phi => qconsts_update_gen qconst_str (qcinfo phi)) lthy'
in
((trm, thm), lthy'')
end
--- a/quotient_info.ML Sat Nov 21 14:45:25 2009 +0100
+++ b/quotient_info.ML Sat Nov 21 23:23:01 2009 +0100
@@ -45,7 +45,6 @@
fun maps_update_thy k minfo = MapsData.map (Symtab.update (k, minfo))
fun maps_update k minfo = ProofContext.theory (maps_update_thy k minfo)
-(* FIXME: this should be done using a generic context *)
fun maps_attribute_aux s minfo = Thm.declaration_attribute
(fn thm => Context.mapping (maps_update_thy s minfo) (maps_update s minfo))
@@ -72,7 +71,7 @@
"declaration of map information"))
-(* info about the quotient types *)
+(* info about quotient types *)
type quotient_info = {qtyp: typ, rtyp: typ, rel: term, equiv_thm: thm}
structure QuotData = Theory_Data
@@ -117,7 +116,7 @@
OuterKeyword.diag (Scan.succeed (Toplevel.keep (print_quotinfo o Toplevel.context_of)))
-(* environments of quotient and raw types *)
+(* FIXME: obsolete: environments for quotient and raw types *)
type qenv = (typ * typ) list
fun mk_qenv ctxt =