--- a/Quot/quotient_typ.ML Thu Feb 11 09:23:59 2010 +0100
+++ b/Quot/quotient_typ.ML Thu Feb 11 10:06:02 2010 +0100
@@ -7,10 +7,10 @@
signature QUOTIENT_TYPE =
sig
- val quotient_type: ((string list * binding * mixfix) * (typ * term)) list
+ val quotient_type: ((string list * binding * mixfix) * (typ * term)) list
-> Proof.context -> Proof.state
- val quotient_type_cmd: ((((string list * binding) * mixfix) * string) * string) list
+ val quotient_type_cmd: ((((string list * binding) * mixfix) * string) * string) list
-> Proof.context -> Proof.state
end;
@@ -41,7 +41,7 @@
let
val goals' = map (rpair []) goals
fun after_qed' thms = after_qed (the_single thms)
-in
+in
Proof.theorem_i NONE after_qed' [goals'] ctxt
end
@@ -155,7 +155,7 @@
(* quot_type theorem *)
val quot_thm = typedef_quot_type_thm (rel, Abs_const, Rep_const, equiv_thm, typedef_info) lthy3
- (* quotient theorem *)
+ (* quotient theorem *)
val quotient_thm = typedef_quotient_thm (rel, abs, rep, abs_def, rep_def, quot_thm) lthy3
val quotient_thm_name = Binding.prefix_name "Quotient_" qty_name
@@ -189,22 +189,22 @@
else [qty_str ^ "illegal schematic variable(s) in the relation."]
val dup_vs =
- (case duplicates (op =) vs of
+ (case duplicates (op =) vs of
[] => []
| dups => [qty_str ^ "duplicate type variable(s) on the lhs: " ^ commas_quote dups])
val extra_rty_tfrees =
- (case subtract (op =) vs rty_tfreesT of
+ (case subtract (op =) vs rty_tfreesT of
[] => []
| extras => [qty_str ^ "extra type variable(s) on the lhs: " ^ commas_quote extras])
val extra_rel_tfrees =
- (case subtract (op =) vs rel_tfrees of
+ (case subtract (op =) vs rel_tfrees of
[] => []
| extras => [qty_str ^ "extra type variable(s) in the relation: " ^ commas_quote extras])
-
+
val illegal_rel_frees =
- (case rel_frees of
+ (case rel_frees of
[] => []
| xs => [qty_str ^ "illegal variable(s) in the relation: " ^ commas_quote xs])
@@ -248,28 +248,28 @@
relations are equivalence relations
*)
-fun quotient_type quot_list lthy =
+fun quotient_type quot_list lthy =
let
- (* sanity check *)
- val _ = List.app sanity_check quot_list
+ (* sanity check *)
+ val _ = List.app sanity_check quot_list
val _ = List.app (map_check lthy) quot_list
fun mk_goal (rty, rel) =
let
val equivp_ty = ([rty, rty] ---> @{typ bool}) --> @{typ bool}
- in
+ in
HOLogic.mk_Trueprop (Const (@{const_name equivp}, equivp_ty) $ rel)
end
val goals = map (mk_goal o snd) quot_list
-
+
fun after_qed thms lthy =
fold_map mk_quotient_type (quot_list ~~ thms) lthy |> snd
in
theorem after_qed goals lthy
end
-
-fun quotient_type_cmd specs lthy =
+
+fun quotient_type_cmd specs lthy =
let
fun parse_spec ((((vs, qty_name), mx), rty_str), rel_str) lthy =
let
@@ -278,12 +278,12 @@
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 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 *)
+ val rel = Syntax.read_term lthy rel_str *)
in
(((vs, qty_name, mx), (rty, rel)), lthy2)
end
@@ -293,16 +293,16 @@
quotient_type spec' lthy'
end
-val quotspec_parser =
+val quotspec_parser =
OuterParse.and_list1
- ((OuterParse.type_args -- OuterParse.binding) --
- OuterParse.opt_infix -- (OuterParse.$$$ "=" |-- OuterParse.typ) --
+ ((OuterParse.type_args -- OuterParse.binding) --
+ OuterParse.opt_infix -- (OuterParse.$$$ "=" |-- OuterParse.typ) --
(OuterParse.$$$ "/" |-- OuterParse.term))
val _ = OuterKeyword.keyword "/"
-val _ =
- OuterSyntax.local_theory_to_proof "quotient_type"
+val _ =
+ OuterSyntax.local_theory_to_proof "quotient_type"
"quotient type definitions (require equivalence proofs)"
OuterKeyword.thy_goal (quotspec_parser >> quotient_type_cmd)