src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML
changeset 53746 bd038e48526d
parent 53741 c9068aade859
child 53832 bde758ba3029
equal deleted inserted replaced
53745:788730ab7da4 53746:bd038e48526d
   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;