232 val tuple_rew_rules = map meta_eq_of [@{thm fst_conv}, @{thm snd_conv}, @{thm Pair_eq}] |
232 val tuple_rew_rules = map meta_eq_of [@{thm fst_conv}, @{thm snd_conv}, @{thm Pair_eq}] |
233 fun instantiate i n {context, params, prems, asms, concl, schematics} = |
233 fun instantiate i n {context, params, prems, asms, concl, schematics} = |
234 let |
234 let |
235 fun term_pair_of (ix, (ty,t)) = (Var (ix,ty), t) |
235 fun term_pair_of (ix, (ty,t)) = (Var (ix,ty), t) |
236 fun inst_of_matches tts = fold (Pattern.match thy) tts (Vartab.empty, Vartab.empty) |
236 fun inst_of_matches tts = fold (Pattern.match thy) tts (Vartab.empty, Vartab.empty) |
237 |> snd |> Vartab.dest |> map (pairself (cterm_of thy) o term_pair_of) |
237 |> snd |> Vartab.dest |> map (apply2 (cterm_of thy) o term_pair_of) |
238 val (cases, (eqs, prems)) = apsnd (chop (nargs - nparams)) (chop n prems) |
238 val (cases, (eqs, prems)) = apsnd (chop (nargs - nparams)) (chop n prems) |
239 val case_th = |
239 val case_th = |
240 rewrite_rule ctxt (@{thm Predicate.eq_is_eq} :: map meta_eq_of eqs) (nth cases (i - 1)) |
240 rewrite_rule ctxt (@{thm Predicate.eq_is_eq} :: map meta_eq_of eqs) (nth cases (i - 1)) |
241 val prems' = maps (dest_conjunct_prem o rewrite_rule ctxt tuple_rew_rules) prems |
241 val prems' = maps (dest_conjunct_prem o rewrite_rule ctxt tuple_rew_rules) prems |
242 val pats = |
242 val pats = |
443 |
443 |
444 fun force_modes_and_compilations pred_name compilations thy = |
444 fun force_modes_and_compilations pred_name compilations thy = |
445 let |
445 let |
446 (* thm refl is a dummy thm *) |
446 (* thm refl is a dummy thm *) |
447 val modes = map fst compilations |
447 val modes = map fst compilations |
448 val (needs_random, non_random_modes) = pairself (map fst) |
448 val (needs_random, non_random_modes) = |
449 (List.partition (fn (_, (_, random)) => random) compilations) |
449 apply2 (map fst) (List.partition (fn (_, (_, random)) => random) compilations) |
450 val non_random_dummys = map (rpair "dummy") non_random_modes |
450 val non_random_dummys = map (rpair "dummy") non_random_modes |
451 val all_dummys = map (rpair "dummy") modes |
451 val all_dummys = map (rpair "dummy") modes |
452 val dummy_function_names = |
452 val dummy_function_names = |
453 map (rpair all_dummys) Predicate_Compile_Aux.random_compilations @ |
453 map (rpair all_dummys) Predicate_Compile_Aux.random_compilations @ |
454 map (rpair non_random_dummys) Predicate_Compile_Aux.non_random_compilations |
454 map (rpair non_random_dummys) Predicate_Compile_Aux.non_random_compilations |