# HG changeset patch # User blanchet # Date 1410772664 -7200 # Node ID 568fb4e382c913bcb432c8253fbb1cd412321248 # Parent a7add8066122ccf77815448f2e7ee9b9d84b596c tuning diff -r a7add8066122 -r 568fb4e382c9 src/HOL/Tools/BNF/bnf_fp_def_sugar.ML --- a/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Mon Sep 15 11:10:09 2014 +0200 +++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Mon Sep 15 11:17:44 2014 +0200 @@ -1353,10 +1353,13 @@ val fpTs = map (domain_type o fastype_of) dtors; val fpBTs = map B_ify fpTs; + val code_attrs = if plugins code_plugin then [Code.add_default_eqn_attrib] else []; + fun massage_simple_notes base = filter_out (null o #2) #> map (fn (thmN, thms, f_attrs) => - ((Binding.qualify true base (Binding.name thmN), []), map_index (fn (i, thm) => ([thm], f_attrs i)) thms)); + ((Binding.qualify true base (Binding.name thmN), []), + map_index (fn (i, thm) => ([thm], f_attrs i)) thms)); val massage_multi_notes = maps (fn (thmN, thmss, attrs) => @@ -1365,8 +1368,6 @@ fp_b_names fpTs thmss) #> filter_out (null o fst o hd o snd); - val code_attrs = if plugins code_plugin then [Code.add_default_eqn_attrib] else []; - val ctr_Tsss = map (map (map (Term.typ_subst_atomic (Xs ~~ fpTs)))) ctrXs_Tsss; val ns = map length ctr_Tsss; val kss = map (fn n => 1 upto n) ns; diff -r a7add8066122 -r 568fb4e382c9 src/HOL/Tools/BNF/bnf_fp_rec_sugar_util.ML --- a/src/HOL/Tools/BNF/bnf_fp_rec_sugar_util.ML Mon Sep 15 11:10:09 2014 +0200 +++ b/src/HOL/Tools/BNF/bnf_fp_rec_sugar_util.ML Mon Sep 15 11:17:44 2014 +0200 @@ -77,7 +77,7 @@ | num_binder_types _ = 0; val exists_subtype_in = Term.exists_subtype o member (op =); -fun exists_strict_subtype_in Ts T = exists_subtype_in (filter_out (curry (op =) T) Ts) T; +fun exists_strict_subtype_in Ts T = exists_subtype_in (remove (op =) T Ts) T; fun tvar_subst thy Ts Us = Vartab.fold (cons o apsnd snd) (fold (Sign.typ_match thy) (Ts ~~ Us) Vartab.empty) []; diff -r a7add8066122 -r 568fb4e382c9 src/HOL/Tools/BNF/bnf_lfp_size.ML --- a/src/HOL/Tools/BNF/bnf_lfp_size.ML Mon Sep 15 11:10:09 2014 +0200 +++ b/src/HOL/Tools/BNF/bnf_lfp_size.ML Mon Sep 15 11:17:44 2014 +0200 @@ -22,13 +22,13 @@ open BNF_Def open BNF_FP_Def_Sugar -val size_plugin = "size" +val size_plugin = "size"; -val size_N = "size_" +val size_N = "size_"; -val rec_o_mapN = "rec_o_map" -val sizeN = "size" -val size_o_mapN = "size_o_map" +val rec_o_mapN = "rec_o_map"; +val sizeN = "size"; +val size_o_mapN = "size_o_map"; val nitpicksimp_attrs = @{attributes [nitpick_simp]}; val simp_attrs = @{attributes [simp]}; @@ -50,14 +50,12 @@ val size_of = Symtab.lookup o Data.get o Context.Proof; val size_of_global = Symtab.lookup o Data.get o Context.Theory; -val zero_nat = @{const zero_class.zero (nat)}; - fun mk_plus_nat (t1, t2) = Const (@{const_name Groups.plus}, HOLogic.natT --> HOLogic.natT --> HOLogic.natT) $ t1 $ t2; fun mk_to_natT T = T --> HOLogic.natT; -fun mk_abs_zero_nat T = Term.absdummy T zero_nat; +fun mk_abs_zero_nat T = Term.absdummy T HOLogic.zero; fun pointfill ctxt th = unfold_thms ctxt [o_apply] (th RS fun_cong); @@ -155,7 +153,7 @@ val xs = map2 (curry Free) x_names x_Ts; val (summands, size_o_maps') = fold_map mk_size_of_arg xs size_o_maps - |>> remove (op =) zero_nat; + |>> remove (op =) HOLogic.zero; val sum = if null summands then HOLogic.zero else foldl1 mk_plus_nat (summands @ [HOLogic.Suc_zero]);