346 |
346 |
347 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy = |
347 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy = |
348 let |
348 let |
349 val thy = Proof_Context.theory_of lthy; |
349 val thy = Proof_Context.theory_of lthy; |
350 |
350 |
351 val ((nontriv, missing_arg_Ts, perm0_kks, |
351 val ((missing_arg_Ts, perm0_kks, |
352 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...}, |
352 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...}, |
353 co_inducts = [induct_thm], ...} :: _), lthy') = |
353 co_inducts = [induct_thm], ...} :: _, (lfp_sugar_thms, _)), lthy') = |
354 nested_to_mutual_fps lose_co_rec Least_FP bs arg_Ts get_indices callssss0 lthy; |
354 nested_to_mutual_fps lose_co_rec Least_FP bs arg_Ts get_indices callssss0 lthy; |
355 |
355 |
356 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
356 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
357 |
357 |
358 val indices = map #index fp_sugars; |
358 val indices = map #index fp_sugars; |
421 {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)), |
421 {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)), |
422 nested_map_idents = map (unfold_thms lthy [id_def] o map_id0_of_bnf) nested_bnfs, |
422 nested_map_idents = map (unfold_thms lthy [id_def] o map_id0_of_bnf) nested_bnfs, |
423 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
423 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
424 ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss}; |
424 ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss}; |
425 in |
425 in |
426 ((nontriv, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms), lthy') |
426 ((is_some lfp_sugar_thms, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms), |
|
427 lthy') |
427 end; |
428 end; |
428 |
429 |
429 fun corec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy = |
430 fun corec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy = |
430 let |
431 let |
431 val thy = Proof_Context.theory_of lthy; |
432 val thy = Proof_Context.theory_of lthy; |
432 |
433 |
433 val ((nontriv, missing_res_Ts, perm0_kks, |
434 val ((missing_res_Ts, perm0_kks, |
434 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = dtor_coiters1 :: _, ...}, |
435 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = dtor_coiters1 :: _, ...}, |
435 co_inducts = coinduct_thms, ...} :: _), lthy') = |
436 co_inducts = coinduct_thms, ...} :: _, (_, gfp_sugar_thms)), lthy') = |
436 nested_to_mutual_fps lose_co_rec Greatest_FP bs res_Ts get_indices callssss0 lthy; |
437 nested_to_mutual_fps lose_co_rec Greatest_FP bs res_Ts get_indices callssss0 lthy; |
437 |
438 |
438 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
439 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
439 |
440 |
440 val indices = map #index fp_sugars; |
441 val indices = map #index fp_sugars; |
524 nested_map_idents = map (unfold_thms lthy [id_def] o map_id0_of_bnf) nested_bnfs, |
525 nested_map_idents = map (unfold_thms lthy [id_def] o map_id0_of_bnf) nested_bnfs, |
525 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
526 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
526 ctr_specs = mk_ctr_specs index ctr_sugars p_is q_isss f_isss f_Tsss coiter_thmsss |
527 ctr_specs = mk_ctr_specs index ctr_sugars p_is q_isss f_isss f_Tsss coiter_thmsss |
527 disc_coitersss sel_coiterssss}; |
528 disc_coitersss sel_coiterssss}; |
528 in |
529 in |
529 ((nontriv, map5 mk_spec fp_sugars p_iss q_issss f_issss f_Tssss, missing_res_Ts, |
530 ((is_some gfp_sugar_thms, map5 mk_spec fp_sugars p_iss q_issss f_issss f_Tssss, missing_res_Ts, |
530 co_induct_of coinduct_thms, strong_co_induct_of coinduct_thms, co_induct_of coinduct_thmss, |
531 co_induct_of coinduct_thms, strong_co_induct_of coinduct_thms, co_induct_of coinduct_thmss, |
531 strong_co_induct_of coinduct_thmss), lthy') |
532 strong_co_induct_of coinduct_thmss), lthy') |
532 end; |
533 end; |
533 |
534 |
534 end; |
535 end; |