273 ||> (fn info => (NONE, SOME info)); |
273 ||> (fn info => (NONE, SOME info)); |
274 |
274 |
275 val phi = Proof_Context.export_morphism no_defs_lthy no_defs_lthy0; |
275 val phi = Proof_Context.export_morphism no_defs_lthy no_defs_lthy0; |
276 |
276 |
277 fun mk_target_fp_sugar T X kk pre_bnf absT_info ctrXs_Tss ctr_defs ctr_sugar co_rec maps |
277 fun mk_target_fp_sugar T X kk pre_bnf absT_info ctrXs_Tss ctr_defs ctr_sugar co_rec maps |
278 co_inducts co_rec_thms disc_corec_thms sel_corec_thmss = |
278 co_inducts co_rec_thms disc_corec_thms sel_corec_thmss rel_injects = |
279 {T = T, X = X, fp = fp, fp_res = fp_res, fp_res_index = kk, pre_bnf = pre_bnf, |
279 {T = T, X = X, fp = fp, fp_res = fp_res, fp_res_index = kk, pre_bnf = pre_bnf, |
280 absT_info = absT_info, nested_bnfs = nested_bnfs, nesting_bnfs = nesting_bnfs, |
280 absT_info = absT_info, nested_bnfs = nested_bnfs, nesting_bnfs = nesting_bnfs, |
281 ctrXs_Tss = ctrXs_Tss, ctr_defs = ctr_defs, ctr_sugar = ctr_sugar, co_rec = co_rec, |
281 ctrXs_Tss = ctrXs_Tss, ctr_defs = ctr_defs, ctr_sugar = ctr_sugar, co_rec = co_rec, |
282 maps = maps, common_co_inducts = common_co_inducts, co_inducts = co_inducts, |
282 maps = maps, common_co_inducts = common_co_inducts, co_inducts = co_inducts, |
283 co_rec_thms = co_rec_thms, disc_co_recs = disc_corec_thms, |
283 co_rec_thms = co_rec_thms, disc_co_recs = disc_corec_thms, |
284 sel_co_recss = sel_corec_thmss} |
284 sel_co_recss = sel_corec_thmss, rel_injects = rel_injects} |
285 |> morph_fp_sugar phi; |
285 |> morph_fp_sugar phi; |
286 |
286 |
287 val target_fp_sugars = |
287 val target_fp_sugars = |
288 map14 mk_target_fp_sugar fpTs Xs kks pre_bnfs absT_infos ctrXs_Tsss ctr_defss ctr_sugars |
288 map15 mk_target_fp_sugar fpTs Xs kks pre_bnfs absT_infos ctrXs_Tsss ctr_defss ctr_sugars |
289 co_recs mapss (transpose co_inductss) co_rec_thmss disc_corec_thmss sel_corec_thmsss; |
289 co_recs mapss (transpose co_inductss) co_rec_thmss disc_corec_thmss sel_corec_thmsss |
|
290 (map #rel_injects fp_sugars0); |
290 |
291 |
291 val n2m_sugar = (target_fp_sugars, fp_sugar_thms); |
292 val n2m_sugar = (target_fp_sugars, fp_sugar_thms); |
292 in |
293 in |
293 (n2m_sugar, lthy |> register_n2m_sugar key n2m_sugar) |
294 (n2m_sugar, lthy |> register_n2m_sugar key n2m_sugar) |
294 end) |
295 end) |