changeset 49221 | 6d8d5fe9f3a2 |
parent 49220 | a6260b4fb410 |
child 49224 | 60a0394d98f7 |
49220:a6260b4fb410 | 49221:6d8d5fe9f3a2 |
---|---|
220 (((gss, g_Tss, map (map (map single)) ysss), (hss, h_Tss, zssss)), |
220 (((gss, g_Tss, map (map (map single)) ysss), (hss, h_Tss, zssss)), |
221 ([], [], [], (([], []), [], [], []), (([], []), [], [], []))) |
221 ([], [], [], (([], []), [], [], []), (([], []), [], [], []))) |
222 end |
222 end |
223 else |
223 else |
224 let |
224 let |
225 (*avoid "'a itself" arguments in coiterators and corecursors*) |
|
226 val mss' = map (fn [0] => [1] | ms => ms) mss; |
|
227 |
|
225 val p_Tss = |
228 val p_Tss = |
226 map2 (fn C => fn n => replicate (Int.max (0, n - 1)) (C --> HOLogic.boolT)) Cs ns; |
229 map2 (fn C => fn n => replicate (Int.max (0, n - 1)) (C --> HOLogic.boolT)) Cs ns; |
227 |
230 |
228 fun popescu_zip [] [fs] = fs |
231 fun popescu_zip [] [fs] = fs |
229 | popescu_zip (p :: ps) (fs :: fss) = p :: fs @ popescu_zip ps fss; |
232 | popescu_zip (p :: ps) (fs :: fss) = p :: fs @ popescu_zip ps fss; |
231 fun mk_types fun_Ts = |
234 fun mk_types fun_Ts = |
232 let |
235 let |
233 val f_sum_prod_Ts = map range_type fun_Ts; |
236 val f_sum_prod_Ts = map range_type fun_Ts; |
234 val f_prod_Tss = map2 dest_sumTN ns f_sum_prod_Ts; |
237 val f_prod_Tss = map2 dest_sumTN ns f_sum_prod_Ts; |
235 val f_Tsss = |
238 val f_Tsss = |
236 map3 (fn C => map2 (map (curry (op -->) C) oo dest_tupleT)) Cs mss f_prod_Tss; |
239 map3 (fn C => map2 (map (curry (op -->) C) oo dest_tupleT)) Cs mss' f_prod_Tss; |
237 val pf_Tss = map2 popescu_zip p_Tss f_Tsss |
240 val pf_Tss = map2 popescu_zip p_Tss f_Tsss |
238 in (f_sum_prod_Ts, f_prod_Tss, f_Tsss, pf_Tss) end; |
241 in (f_sum_prod_Ts, f_prod_Tss, f_Tsss, pf_Tss) end; |
239 |
242 |
240 val (g_sum_prod_Ts, g_prod_Tss, g_Tsss, pg_Tss) = mk_types fp_iter_fun_Ts; |
243 val (g_sum_prod_Ts, g_prod_Tss, g_Tsss, pg_Tss) = mk_types fp_iter_fun_Ts; |
241 val (h_sum_prod_Ts, h_prod_Tss, h_Tsss, ph_Tss) = mk_types fp_rec_fun_Ts; |
244 val (h_sum_prod_Ts, h_prod_Tss, h_Tsss, ph_Tss) = mk_types fp_rec_fun_Ts; |