src/HOL/Tools/Predicate_Compile/core_data.ML
changeset 59058 a78612c67ec0
parent 58823 513268cb2178
child 59481 74f638efffcb
equal deleted inserted replaced
59057:5b649fb2f2e1 59058:a78612c67ec0
   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