35 common_co_inducts: thm list, |
35 common_co_inducts: thm list, |
36 co_inducts: thm list, |
36 co_inducts: thm list, |
37 co_rec_def: thm, |
37 co_rec_def: thm, |
38 co_rec_thms: thm list, |
38 co_rec_thms: thm list, |
39 co_rec_discs: thm list, |
39 co_rec_discs: thm list, |
|
40 co_rec_disc_iffs: thm list, |
40 co_rec_selss: thm list list} |
41 co_rec_selss: thm list list} |
41 |
42 |
42 type fp_sugar = |
43 type fp_sugar = |
43 {T: typ, |
44 {T: typ, |
44 BT: typ, |
45 BT: typ, |
199 common_co_inducts: thm list, |
200 common_co_inducts: thm list, |
200 co_inducts: thm list, |
201 co_inducts: thm list, |
201 co_rec_def: thm, |
202 co_rec_def: thm, |
202 co_rec_thms: thm list, |
203 co_rec_thms: thm list, |
203 co_rec_discs: thm list, |
204 co_rec_discs: thm list, |
|
205 co_rec_disc_iffs: thm list, |
204 co_rec_selss: thm list list}; |
206 co_rec_selss: thm list list}; |
205 |
207 |
206 type fp_sugar = |
208 type fp_sugar = |
207 {T: typ, |
209 {T: typ, |
208 BT: typ, |
210 BT: typ, |
232 set_sels = map (Morphism.thm phi) set_sels, |
234 set_sels = map (Morphism.thm phi) set_sels, |
233 set_intros = map (Morphism.thm phi) set_intros, |
235 set_intros = map (Morphism.thm phi) set_intros, |
234 set_cases = map (Morphism.thm phi) set_cases}; |
236 set_cases = map (Morphism.thm phi) set_cases}; |
235 |
237 |
236 fun morph_fp_co_induct_sugar phi ({co_rec, common_co_inducts, co_inducts, co_rec_def, co_rec_thms, |
238 fun morph_fp_co_induct_sugar phi ({co_rec, common_co_inducts, co_inducts, co_rec_def, co_rec_thms, |
237 co_rec_discs, co_rec_selss} : fp_co_induct_sugar) = |
239 co_rec_discs, co_rec_disc_iffs, co_rec_selss} : fp_co_induct_sugar) = |
238 {co_rec = Morphism.term phi co_rec, |
240 {co_rec = Morphism.term phi co_rec, |
239 common_co_inducts = map (Morphism.thm phi) common_co_inducts, |
241 common_co_inducts = map (Morphism.thm phi) common_co_inducts, |
240 co_inducts = map (Morphism.thm phi) co_inducts, |
242 co_inducts = map (Morphism.thm phi) co_inducts, |
241 co_rec_def = Morphism.thm phi co_rec_def, |
243 co_rec_def = Morphism.thm phi co_rec_def, |
242 co_rec_thms = map (Morphism.thm phi) co_rec_thms, |
244 co_rec_thms = map (Morphism.thm phi) co_rec_thms, |
243 co_rec_discs = map (Morphism.thm phi) co_rec_discs, |
245 co_rec_discs = map (Morphism.thm phi) co_rec_discs, |
|
246 co_rec_disc_iffs = map (Morphism.thm phi) co_rec_disc_iffs, |
244 co_rec_selss = map (map (Morphism.thm phi)) co_rec_selss}; |
247 co_rec_selss = map (map (Morphism.thm phi)) co_rec_selss}; |
245 |
248 |
246 fun morph_fp_ctr_sugar phi ({ctrXs_Tss, ctr_defs, ctr_sugar, ctr_transfers, case_transfers, |
249 fun morph_fp_ctr_sugar phi ({ctrXs_Tss, ctr_defs, ctr_sugar, ctr_transfers, case_transfers, |
247 disc_transfers} : fp_ctr_sugar) = |
250 disc_transfers} : fp_ctr_sugar) = |
248 {ctrXs_Tss = map (map (Morphism.typ phi)) ctrXs_Tss, |
251 {ctrXs_Tss = map (map (Morphism.typ phi)) ctrXs_Tss, |
318 |
321 |
319 fun interpret_bnfs_register_fp_sugars plugins Ts BTs Xs fp pre_bnfs absT_infos fp_nesting_bnfs |
322 fun interpret_bnfs_register_fp_sugars plugins Ts BTs Xs fp pre_bnfs absT_infos fp_nesting_bnfs |
320 live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars co_recs co_rec_defs map_thmss |
323 live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars co_recs co_rec_defs map_thmss |
321 common_co_inducts co_inductss co_rec_thmss co_rec_discss co_rec_selsss rel_injectss |
324 common_co_inducts co_inductss co_rec_thmss co_rec_discss co_rec_selsss rel_injectss |
322 rel_distinctss map_disc_iffss map_selss rel_selss rel_intross rel_casess set_thmss set_selss |
325 rel_distinctss map_disc_iffss map_selss rel_selss rel_intross rel_casess set_thmss set_selss |
323 set_intross set_casess ctr_transferss case_transferss disc_transferss noted = |
326 set_intross set_casess ctr_transferss case_transferss disc_transferss co_rec_disc_iffss noted = |
324 let |
327 let |
325 val fp_sugars = |
328 val fp_sugars = |
326 map_index (fn (kk, T) => |
329 map_index (fn (kk, T) => |
327 {T = T, BT = nth BTs kk, X = nth Xs kk, fp = fp, fp_res = fp_res, fp_res_index = kk, |
330 {T = T, BT = nth BTs kk, X = nth Xs kk, fp = fp, fp_res = fp_res, fp_res_index = kk, |
328 pre_bnf = nth pre_bnfs kk, absT_info = nth absT_infos kk, |
331 pre_bnf = nth pre_bnfs kk, absT_info = nth absT_infos kk, |
352 common_co_inducts = common_co_inducts, |
355 common_co_inducts = common_co_inducts, |
353 co_inducts = nth co_inductss kk, |
356 co_inducts = nth co_inductss kk, |
354 co_rec_def = nth co_rec_defs kk, |
357 co_rec_def = nth co_rec_defs kk, |
355 co_rec_thms = nth co_rec_thmss kk, |
358 co_rec_thms = nth co_rec_thmss kk, |
356 co_rec_discs = nth co_rec_discss kk, |
359 co_rec_discs = nth co_rec_discss kk, |
|
360 co_rec_disc_iffs = nth co_rec_disc_iffss kk, |
357 co_rec_selss = nth co_rec_selsss kk}} |
361 co_rec_selss = nth co_rec_selsss kk}} |
358 |> morph_fp_sugar (substitute_noted_thm noted)) Ts; |
362 |> morph_fp_sugar (substitute_noted_thm noted)) Ts; |
359 in |
363 in |
360 register_fp_sugars_raw fp_sugars |
364 register_fp_sugars_raw fp_sugars |
361 #> fold (interpret_bnf plugins) (#bnfs fp_res) |
365 #> fold (interpret_bnf plugins) (#bnfs fp_res) |
2199 |-> interpret_bnfs_register_fp_sugars plugins fpTs fpBTs Xs Least_FP pre_bnfs absT_infos |
2203 |-> interpret_bnfs_register_fp_sugars plugins fpTs fpBTs Xs Least_FP pre_bnfs absT_infos |
2200 fp_nesting_bnfs live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars recs rec_defs |
2204 fp_nesting_bnfs live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars recs rec_defs |
2201 map_thmss [induct_thm] (map single induct_thms) rec_thmss (replicate nn []) |
2205 map_thmss [induct_thm] (map single induct_thms) rec_thmss (replicate nn []) |
2202 (replicate nn []) rel_injectss rel_distinctss map_disc_iffss map_selss rel_selss |
2206 (replicate nn []) rel_injectss rel_distinctss map_disc_iffss map_selss rel_selss |
2203 rel_intross rel_casess set_thmss set_selss set_intross set_casess ctr_transferss |
2207 rel_intross rel_casess set_thmss set_selss set_intross set_casess ctr_transferss |
2204 case_transferss disc_transferss |
2208 case_transferss disc_transferss (replicate nn []) |
2205 end; |
2209 end; |
2206 |
2210 |
2207 fun derive_corec_transfer_thms lthy corecs corec_defs = |
2211 fun derive_corec_transfer_thms lthy corecs corec_defs = |
2208 let |
2212 let |
2209 val (Rs, Ss, goals, names_lthy) = mk_co_rec_transfer_goals lthy corecs; |
2213 val (Rs, Ss, goals, names_lthy) = mk_co_rec_transfer_goals lthy corecs; |
2317 fp_nesting_bnfs live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars corecs corec_defs |
2321 fp_nesting_bnfs live_nesting_bnfs fp_res ctrXs_Tsss ctr_defss ctr_sugars corecs corec_defs |
2318 map_thmss [coinduct_thm, coinduct_strong_thm] |
2322 map_thmss [coinduct_thm, coinduct_strong_thm] |
2319 (transpose [coinduct_thms, coinduct_strong_thms]) corec_thmss corec_disc_thmss |
2323 (transpose [coinduct_thms, coinduct_strong_thms]) corec_thmss corec_disc_thmss |
2320 corec_sel_thmsss rel_injectss rel_distinctss map_disc_iffss map_selss rel_selss |
2324 corec_sel_thmsss rel_injectss rel_distinctss map_disc_iffss map_selss rel_selss |
2321 rel_intross rel_casess set_thmss set_selss set_intross set_casess ctr_transferss |
2325 rel_intross rel_casess set_thmss set_selss set_intross set_casess ctr_transferss |
2322 case_transferss disc_transferss |
2326 case_transferss disc_transferss corec_disc_iff_thmss |
2323 end; |
2327 end; |
2324 |
2328 |
2325 val lthy'' = lthy' |
2329 val lthy'' = lthy' |
2326 |> live > 0 ? fold2 (fn Type (s, _) => fn bnf => register_bnf_raw s bnf) fpTs fp_bnfs |
2330 |> live > 0 ? fold2 (fn Type (s, _) => fn bnf => register_bnf_raw s bnf) fpTs fp_bnfs |
2327 |> fold_map define_ctrs_dtrs_for_type (fp_bnfs ~~ fp_bs ~~ fpTs ~~ ctors ~~ dtors ~~ |
2331 |> fold_map define_ctrs_dtrs_for_type (fp_bnfs ~~ fp_bs ~~ fpTs ~~ ctors ~~ dtors ~~ |