--- a/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML Tue May 07 16:43:17 2013 +0200
+++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML Tue May 07 17:07:37 2013 +0200
@@ -13,6 +13,7 @@
index: int,
pre_bnfs: BNF_Def.bnf list,
fp_res: BNF_FP_Util.fp_result,
+ ctr_defss: thm list list,
ctr_sugars: BNF_Ctr_Sugar.ctr_sugar list,
un_folds: term list,
co_recs: term list,
@@ -98,6 +99,7 @@
index: int,
pre_bnfs: bnf list,
fp_res: fp_result,
+ ctr_defss: thm list list,
ctr_sugars: ctr_sugar list,
un_folds: term list,
co_recs: term list,
@@ -110,12 +112,13 @@
{T = T2, lfp = lfp2, index = index2, fp_res = fp_res2, ...} : fp_sugar) =
T1 = T2 andalso lfp1 = lfp2 andalso index1 = index2 andalso eq_fp_result (fp_res1, fp_res2);
-fun morph_fp_sugar phi {T, lfp, index, pre_bnfs, fp_res, ctr_sugars, un_folds, co_recs, co_induct,
- strong_co_induct, un_fold_thmss, co_rec_thmss} =
+fun morph_fp_sugar phi {T, lfp, index, pre_bnfs, fp_res, ctr_defss, ctr_sugars, un_folds, co_recs,
+ co_induct, strong_co_induct, un_fold_thmss, co_rec_thmss} =
{T = Morphism.typ phi T, lfp = lfp, index = index, pre_bnfs = map (morph_bnf phi) pre_bnfs,
- fp_res = morph_fp_result phi fp_res, ctr_sugars = map (morph_ctr_sugar phi) ctr_sugars,
- un_folds = map (Morphism.term phi) un_folds, co_recs = map (Morphism.term phi) co_recs,
- co_induct = Morphism.thm phi co_induct, strong_co_induct = Morphism.thm phi strong_co_induct,
+ fp_res = morph_fp_result phi fp_res, ctr_defss = map (map (Morphism.thm phi)) ctr_defss,
+ ctr_sugars = map (morph_ctr_sugar phi) ctr_sugars, un_folds = map (Morphism.term phi) un_folds,
+ co_recs = map (Morphism.term phi) co_recs, co_induct = Morphism.thm phi co_induct,
+ strong_co_induct = Morphism.thm phi strong_co_induct,
un_fold_thmss = map (map (Morphism.thm phi)) un_fold_thmss,
co_rec_thmss = map (map (Morphism.thm phi)) co_rec_thmss};
@@ -133,13 +136,13 @@
Local_Theory.declaration {syntax = false, pervasive = true}
(fn phi => Data.map (Symtab.update_new (key, morph_fp_sugar phi fp_sugar)));
-fun register_fp_sugars lfp pre_bnfs (fp_res as {Ts, ...}) ctr_sugars un_folds co_recs co_induct
- strong_co_induct un_fold_thmss co_rec_thmss lthy =
+fun register_fp_sugars lfp pre_bnfs (fp_res as {Ts, ...}) ctr_defss ctr_sugars un_folds co_recs
+ co_induct strong_co_induct un_fold_thmss co_rec_thmss lthy =
(0, lthy)
|> fold (fn T as Type (s, _) => fn (kk, lthy) => (kk + 1,
register_fp_sugar s {T = T, lfp = lfp, index = kk, pre_bnfs = pre_bnfs, fp_res = fp_res,
- ctr_sugars = ctr_sugars, un_folds = un_folds, co_recs = co_recs, co_induct = co_induct,
- strong_co_induct = strong_co_induct, un_fold_thmss = un_fold_thmss,
+ ctr_defss = ctr_defss, ctr_sugars = ctr_sugars, un_folds = un_folds, co_recs = co_recs,
+ co_induct = co_induct, strong_co_induct = strong_co_induct, un_fold_thmss = un_fold_thmss,
co_rec_thmss = co_rec_thmss} lthy)) Ts
|> snd;
@@ -1348,8 +1351,8 @@
in
lthy
|> Local_Theory.notes (common_notes @ notes) |> snd
- |> register_fp_sugars true pre_bnfs fp_res ctr_sugars folds recs induct_thm induct_thm
- fold_thmss rec_thmss
+ |> register_fp_sugars true pre_bnfs fp_res ctr_defss ctr_sugars folds recs induct_thm
+ induct_thm fold_thmss rec_thmss
end;
fun derive_and_note_coinduct_unfold_corec_thms_for_types
@@ -1407,7 +1410,7 @@
in
lthy
|> Local_Theory.notes (anonymous_notes @ common_notes @ notes) |> snd
- |> register_fp_sugars false pre_bnfs fp_res ctr_sugars unfolds corecs coinduct_thm
+ |> register_fp_sugars false pre_bnfs fp_res ctr_defss ctr_sugars unfolds corecs coinduct_thm
strong_coinduct_thm unfold_thmss corec_thmss
end;