131 | massage_call t = if t = y then y_of_y' () else ill_formed_rec_call ctxt t; |
131 | massage_call t = if t = y then y_of_y' () else ill_formed_rec_call ctxt t; |
132 in |
132 in |
133 massage_call |
133 massage_call |
134 end; |
134 end; |
135 |
135 |
136 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy = |
136 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy0 = |
137 let |
137 let |
138 val thy = Proof_Context.theory_of lthy; |
138 val thy = Proof_Context.theory_of lthy0; |
139 |
139 |
140 val ((missing_arg_Ts, perm0_kks, |
140 val ((missing_arg_Ts, perm0_kks, |
141 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...}, |
141 fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...}, |
142 co_inducts = [induct_thm], ...} :: _, (lfp_sugar_thms, _)), lthy') = |
142 co_inducts = [induct_thm], ...} :: _, (lfp_sugar_thms, _)), lthy) = |
143 nested_to_mutual_fps Least_FP bs arg_Ts get_indices callssss0 lthy; |
143 nested_to_mutual_fps Least_FP bs arg_Ts get_indices callssss0 lthy0; |
144 |
144 |
145 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
145 val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars; |
146 |
146 |
147 val indices = map #index fp_sugars; |
147 val indices = map #index fp_sugars; |
148 val perm_indices = map #index perm_fp_sugars; |
148 val perm_indices = map #index perm_fp_sugars; |
212 {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)), |
212 {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)), |
213 nested_map_idents = map (unfold_thms lthy @{thms id_def} o map_id0_of_bnf) nested_bnfs, |
213 nested_map_idents = map (unfold_thms lthy @{thms id_def} o map_id0_of_bnf) nested_bnfs, |
214 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
214 nested_map_comps = map map_comp_of_bnf nested_bnfs, |
215 ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss}; |
215 ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss}; |
216 in |
216 in |
217 ((is_some lfp_sugar_thms, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms), |
217 ((is_some lfp_sugar_thms, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms), lthy) |
218 lthy') |
|
219 end; |
218 end; |
220 |
219 |
221 val undef_const = Const (@{const_name undefined}, dummyT); |
220 val undef_const = Const (@{const_name undefined}, dummyT); |
222 |
221 |
223 fun permute_args n t = |
222 fun permute_args n t = |