358 val corec_args = mk_args sssss hssss; |
358 val corec_args = mk_args sssss hssss; |
359 in |
359 in |
360 ((cs, cpss, (unfold_args, unfold_types), (corec_args, corec_types)), lthy) |
360 ((cs, cpss, (unfold_args, unfold_types), (corec_args, corec_types)), lthy) |
361 end; |
361 end; |
362 |
362 |
363 fun mk_un_fold_co_rec_prelims fp fpTs Cs ns mss [xtor_un_folds0, xtor_co_recs0] lthy = |
363 fun mk_un_fold_co_rec_prelims fp fpTs Cs ns mss xtor_co_iterss0 lthy = |
364 let |
364 let |
365 val thy = Proof_Context.theory_of lthy; |
365 val thy = Proof_Context.theory_of lthy; |
366 |
366 |
367 val (xtor_un_fold_fun_Ts, xtor_un_folds) = mk_co_iters thy fp fpTs Cs xtor_un_folds0 |
367 val (xtor_co_iter_fun_Tss, xtor_co_iterss) = |
368 |> `(mk_fp_iter_fun_types o hd); |
368 map (mk_co_iters thy fp fpTs Cs #> `(mk_fp_iter_fun_types o hd)) xtor_co_iterss0 |
369 val (xtor_co_rec_fun_Ts, xtor_co_recs) = mk_co_iters thy fp fpTs Cs xtor_co_recs0 |
369 |> split_list; |
370 |> `(mk_fp_iter_fun_types o hd); |
|
371 |
370 |
372 val ((fold_rec_args_types, unfold_corec_args_types), lthy') = |
371 val ((fold_rec_args_types, unfold_corec_args_types), lthy') = |
373 if fp = Least_FP then |
372 if fp = Least_FP then |
374 mk_fold_rec_args_types Cs ns mss [xtor_un_fold_fun_Ts, xtor_co_rec_fun_Ts] lthy |
373 mk_fold_rec_args_types Cs ns mss xtor_co_iter_fun_Tss lthy |>> (rpair NONE o SOME) |
375 |>> (rpair NONE o SOME) |
|
376 else |
374 else |
377 mk_unfold_corec_args_types Cs ns mss [xtor_un_fold_fun_Ts, xtor_co_rec_fun_Ts] lthy |
375 mk_unfold_corec_args_types Cs ns mss xtor_co_iter_fun_Tss lthy |>> (pair NONE o SOME) |
378 |>> (pair NONE o SOME) |
|
379 in |
376 in |
380 (([xtor_un_folds, xtor_co_recs], fold_rec_args_types, unfold_corec_args_types), lthy') |
377 ((xtor_co_iterss, fold_rec_args_types, unfold_corec_args_types), lthy') |
381 end; |
378 end; |
382 |
379 |
383 fun mk_map live Ts Us t = |
380 fun mk_map live Ts Us t = |
384 let val (Type (_, Ts0), Type (_, Us0)) = strip_typeN (live + 1) (fastype_of t) |>> List.last in |
381 let val (Type (_, Ts0), Type (_, Us0)) = strip_typeN (live + 1) (fastype_of t) |>> List.last in |
385 Term.subst_atomic_types (Ts0 @ Us0 ~~ Ts @ Us) t |
382 Term.subst_atomic_types (Ts0 @ Us0 ~~ Ts @ Us) t |