# HG changeset patch # User bulwahn # Date 1264072721 -3600 # Node ID b206c70ea6f0d60cb2964b62bc5da5aee2ffce3b # Parent a053ad2a7a72e8ce6e5d09668fd2543208ae89f6 adopting predicate compiler to new Spec_Rules and eliminating the use of Nitpick_Simps diff -r a053ad2a7a72 -r b206c70ea6f0 src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Wed Jan 20 18:08:08 2010 +0100 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Thu Jan 21 12:18:41 2010 +0100 @@ -201,16 +201,10 @@ NONE in case map_filter filtering (map (Thm.transfer thy) (Predicate_Compile_Alternative_Defs.get ctxt)) - of [] => (case map_filter - (fn (roughly, (ts, ths)) => - if roughly = Spec_Rules.Equational andalso member (op =) ts t then SOME ths else NONE) - (map ((apsnd o apsnd) (map (Thm.transfer thy))) (Spec_Rules.retrieve ctxt t)) - of [] => Output.cond_timeit true "Nitpick get_spec" - (fn () => (case map_filter filtering (map (Thm.transfer thy) (Nitpick_Simps.get ctxt)) - of [] => map_filter filtering (map (Thm.transfer thy) (Nitpick_Intros.get ctxt)) - | ths => ths)) - | thss => flat thss) - | ths => ths + of [] => (case Spec_Rules.retrieve ctxt t + of [] => rev (map_filter filtering (map (Thm.transfer thy) (Nitpick_Intros.get ctxt))) + | ((_, (_, ths)) :: _) => map (normalize_equation thy o Thm.transfer thy) ths) + | ths => rev ths end) val logic_operator_names = @@ -265,7 +259,7 @@ |> filter is_defining_constname*) fun extend t = let - val specs = rev (get_specification thy t) + val specs = get_specification thy t |> map (inline_equations thy) (*|> Predicate_Compile_Set.unfold_set_notation*) (*val _ = print_specification options thy constname specs*) diff -r a053ad2a7a72 -r b206c70ea6f0 src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML Wed Jan 20 18:08:08 2010 +0100 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML Thu Jan 21 12:18:41 2010 +0100 @@ -340,7 +340,8 @@ val prednames = map (fst o dest_Const) (#preds ind_result) (* val rewr_thms = map mk_rewr_eq ((distinct (op =) funs) ~~ (#preds ind_result)) *) (* add constants to my table *) - val specs = map (fn predname => (predname, filter (Predicate_Compile_Aux.is_intro predname) (#intrs ind_result))) prednames + val specs = map (fn predname => (predname, filter (Predicate_Compile_Aux.is_intro predname) + (#intrs ind_result))) prednames val thy'' = Pred_Compile_Preproc.map (fold Symtab.update_new (consts ~~ prednames)) thy' in (specs, thy'')