added new kind generated_theorem for theorems which are generated by packages to distinguish between theorems from users and packages
authorbulwahn
Sat, 16 May 2009 20:17:59 +0200
changeset 31174f1f1e9b53c81
parent 31173 bbe9e29b9672
child 31175 9b1e7159f4e5
added new kind generated_theorem for theorems which are generated by packages to distinguish between theorems from users and packages
src/HOL/Nominal/nominal_inductive.ML
src/HOL/Nominal/nominal_inductive2.ML
src/HOL/Nominal/nominal_primrec.ML
src/HOL/String.thy
src/HOL/Tools/function_package/fundef_package.ML
src/HOL/Tools/inductive_package.ML
src/HOL/Tools/inductive_realizer.ML
src/HOL/Tools/primrec_package.ML
src/HOL/ex/predicate_compile.ML
src/HOLCF/Tools/fixrec_package.ML
src/Pure/Isar/attrib.ML
src/Pure/Thy/thm_deps.ML
src/Pure/more_thm.ML
     1.1 --- a/src/HOL/Nominal/nominal_inductive.ML	Sat May 16 15:24:35 2009 +0200
     1.2 +++ b/src/HOL/Nominal/nominal_inductive.ML	Sat May 16 20:17:59 2009 +0200
     1.3 @@ -561,7 +561,7 @@
     1.4              (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
     1.5            else (strong_raw_induct RSN (2, rev_mp),
     1.6              [ind_case_names, RuleCases.consumes 1]);
     1.7 -        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
     1.8 +        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.generated_theoremK
     1.9            ((rec_qualified (Binding.name "strong_induct"),
    1.10              map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
    1.11            ctxt;
    1.12 @@ -569,12 +569,12 @@
    1.13            ProjectRule.projects ctxt (1 upto length names) strong_induct'
    1.14        in
    1.15          ctxt' |>
    1.16 -        LocalTheory.note Thm.theoremK
    1.17 +        LocalTheory.note Thm.generated_theoremK
    1.18            ((rec_qualified (Binding.name "strong_inducts"),
    1.19              [Attrib.internal (K ind_case_names),
    1.20               Attrib.internal (K (RuleCases.consumes 1))]),
    1.21             strong_inducts) |> snd |>
    1.22 -        LocalTheory.notes Thm.theoremK (map (fn ((name, elim), (_, cases)) =>
    1.23 +        LocalTheory.notes Thm.generated_theoremK (map (fn ((name, elim), (_, cases)) =>
    1.24              ((Binding.qualified_name (Long_Name.qualify (Long_Name.base_name name) "strong_cases"),
    1.25                [Attrib.internal (K (RuleCases.case_names (map snd cases))),
    1.26                 Attrib.internal (K (RuleCases.consumes 1))]), [([elim], [])]))
    1.27 @@ -664,7 +664,7 @@
    1.28        end) atoms
    1.29    in
    1.30      ctxt |>
    1.31 -    LocalTheory.notes Thm.theoremK (map (fn (name, ths) =>
    1.32 +    LocalTheory.notes Thm.generated_theoremK (map (fn (name, ths) =>
    1.33          ((Binding.qualified_name (Long_Name.qualify (Long_Name.base_name name) "eqvt"),
    1.34            [Attrib.internal (K NominalThmDecls.eqvt_add)]), [(ths, [])]))
    1.35        (names ~~ transp thss)) |> snd
     2.1 --- a/src/HOL/Nominal/nominal_inductive2.ML	Sat May 16 15:24:35 2009 +0200
     2.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML	Sat May 16 20:17:59 2009 +0200
     2.3 @@ -461,7 +461,7 @@
     2.4              (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
     2.5            else (strong_raw_induct RSN (2, rev_mp),
     2.6              [ind_case_names, RuleCases.consumes 1]);
     2.7 -        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
     2.8 +        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.generated_theoremK
     2.9            ((rec_qualified (Binding.name "strong_induct"),
    2.10              map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
    2.11            ctxt;
    2.12 @@ -469,7 +469,7 @@
    2.13            ProjectRule.projects ctxt' (1 upto length names) strong_induct'
    2.14        in
    2.15          ctxt' |>
    2.16 -        LocalTheory.note Thm.theoremK
    2.17 +        LocalTheory.note Thm.generated_theoremK
    2.18            ((rec_qualified (Binding.name "strong_inducts"),
    2.19              [Attrib.internal (K ind_case_names),
    2.20               Attrib.internal (K (RuleCases.consumes 1))]),
     3.1 --- a/src/HOL/Nominal/nominal_primrec.ML	Sat May 16 15:24:35 2009 +0200
     3.2 +++ b/src/HOL/Nominal/nominal_primrec.ML	Sat May 16 20:17:59 2009 +0200
     3.3 @@ -367,11 +367,11 @@
     3.4        (fn thss => fn goal_ctxt =>
     3.5           let
     3.6             val simps = ProofContext.export goal_ctxt lthy' (flat thss);
     3.7 -           val (simps', lthy'') = fold_map (LocalTheory.note Thm.theoremK)
     3.8 +           val (simps', lthy'') = fold_map (LocalTheory.note Thm.generated_theoremK)
     3.9               (names_atts' ~~ map single simps) lthy'
    3.10           in
    3.11             lthy''
    3.12 -           |> LocalTheory.note Thm.theoremK ((qualify (Binding.name "simps"),
    3.13 +           |> LocalTheory.note Thm.generated_theoremK ((qualify (Binding.name "simps"),
    3.14                  map (Attrib.internal o K)
    3.15                      [Simplifier.simp_add, Nitpick_Const_Simp_Thms.add]),
    3.16                  maps snd simps')
     4.1 --- a/src/HOL/String.thy	Sat May 16 15:24:35 2009 +0200
     4.2 +++ b/src/HOL/String.thy	Sat May 16 20:17:59 2009 +0200
     4.3 @@ -55,7 +55,7 @@
     4.4     (fn n => fn m => Drule.instantiate' [] [SOME n, SOME m] @{thm nibble_pair_of_char.simps})
     4.5        nibbles nibbles;
     4.6  in
     4.7 -  PureThy.note_thmss Thm.lemmaK [((Binding.name "nibble_pair_of_char_simps", []), [(thms, [])])]
     4.8 +  PureThy.note_thmss Thm.generated_theoremK [((Binding.name "nibble_pair_of_char_simps", []), [(thms, [])])]
     4.9    #-> (fn [(_, thms)] => fold_rev Code.add_eqn thms)
    4.10  end
    4.11  *}
     5.1 --- a/src/HOL/Tools/function_package/fundef_package.ML	Sat May 16 15:24:35 2009 +0200
     5.2 +++ b/src/HOL/Tools/function_package/fundef_package.ML	Sat May 16 20:17:59 2009 +0200
     5.3 @@ -45,7 +45,7 @@
     5.4       Nitpick_Const_Psimp_Thms.add]
     5.5  
     5.6  fun note_theorem ((name, atts), ths) =
     5.7 -  LocalTheory.note Thm.theoremK ((Binding.qualified_name name, atts), ths)
     5.8 +  LocalTheory.note Thm.generated_theoremK ((Binding.qualified_name name, atts), ths)
     5.9  
    5.10  fun mk_defname fixes = fixes |> map (fst o fst) |> space_implode "_"
    5.11  
    5.12 @@ -56,7 +56,7 @@
    5.13                     |> map (apfst (apfst extra_qualify))
    5.14  
    5.15        val (saved_spec_simps, lthy) =
    5.16 -        fold_map (LocalTheory.note Thm.theoremK) spec lthy
    5.17 +        fold_map (LocalTheory.note Thm.generated_theoremK) spec lthy
    5.18  
    5.19        val saved_simps = flat (map snd saved_spec_simps)
    5.20        val simps_by_f = sort saved_simps
     6.1 --- a/src/HOL/Tools/inductive_package.ML	Sat May 16 15:24:35 2009 +0200
     6.2 +++ b/src/HOL/Tools/inductive_package.ML	Sat May 16 20:17:59 2009 +0200
     6.3 @@ -454,7 +454,7 @@
     6.4      val facts = args |> map (fn ((a, atts), props) =>
     6.5        ((a, map (prep_att thy) atts),
     6.6          map (Thm.no_attributes o single o mk_cases lthy o prep_prop lthy) props));
     6.7 -  in lthy |> LocalTheory.notes Thm.theoremK facts |>> map snd end;
     6.8 +  in lthy |> LocalTheory.notes Thm.generated_theoremK facts |>> map snd end;
     6.9  
    6.10  val inductive_cases = gen_inductive_cases Attrib.intern_src Syntax.read_prop;
    6.11  val inductive_cases_i = gen_inductive_cases (K I) Syntax.check_prop;
    6.12 @@ -849,7 +849,7 @@
    6.13        |> Specification.read_spec (cnames_syn @ pnames_syn) intro_srcs;
    6.14      val (cs, ps) = chop (length cnames_syn) vars;
    6.15      val monos = Attrib.eval_thms lthy raw_monos;
    6.16 -    val flags = {quiet_mode = false, verbose = verbose, kind = Thm.theoremK,
    6.17 +    val flags = {quiet_mode = false, verbose = verbose, kind = Thm.generated_theoremK,
    6.18        alt_name = Binding.empty, coind = coind, no_elim = false, no_ind = false,
    6.19        skip_mono = false, fork_mono = not int};
    6.20    in
     7.1 --- a/src/HOL/Tools/inductive_realizer.ML	Sat May 16 15:24:35 2009 +0200
     7.2 +++ b/src/HOL/Tools/inductive_realizer.ML	Sat May 16 20:17:59 2009 +0200
     7.3 @@ -349,7 +349,7 @@
     7.4  
     7.5      val (ind_info, thy3') = thy2 |>
     7.6        InductivePackage.add_inductive_global (serial_string ())
     7.7 -        {quiet_mode = false, verbose = false, kind = Thm.theoremK, alt_name = Binding.empty,
     7.8 +        {quiet_mode = false, verbose = false, kind = Thm.generated_theoremK, alt_name = Binding.empty,
     7.9            coind = false, no_elim = false, no_ind = false, skip_mono = false, fork_mono = false}
    7.10          rlzpreds rlzparams (map (fn (rintr, intr) =>
    7.11            ((Binding.name (Long_Name.base_name (name_of_thm intr)), []),
     8.1 --- a/src/HOL/Tools/primrec_package.ML	Sat May 16 15:24:35 2009 +0200
     8.2 +++ b/src/HOL/Tools/primrec_package.ML	Sat May 16 20:17:59 2009 +0200
     8.3 @@ -253,8 +253,8 @@
     8.4      |> set_group ? LocalTheory.set_group (serial_string ())
     8.5      |> fold_map (LocalTheory.define Thm.definitionK o make_def lthy fixes fs) defs
     8.6      |-> (fn defs => `(fn ctxt => prove_spec ctxt names1 rec_rewrites defs spec'))
     8.7 -    |-> (fn simps => fold_map (LocalTheory.note Thm.theoremK) simps)
     8.8 -    |-> (fn simps' => LocalTheory.note Thm.theoremK
     8.9 +    |-> (fn simps => fold_map (LocalTheory.note Thm.generated_theoremK) simps)
    8.10 +    |-> (fn simps' => LocalTheory.note Thm.generated_theoremK
    8.11            ((qualify (Binding.qualified_name "simps"), simp_atts), maps snd simps'))
    8.12      |>> snd
    8.13    end handle PrimrecError (msg, some_eqn) =>
     9.1 --- a/src/HOL/ex/predicate_compile.ML	Sat May 16 15:24:35 2009 +0200
     9.2 +++ b/src/HOL/ex/predicate_compile.ML	Sat May 16 20:17:59 2009 +0200
     9.3 @@ -1393,7 +1393,7 @@
     9.4      val (predname, _) = dest_Const pred
     9.5      fun after_qed [[th]] lthy'' =
     9.6        lthy''
     9.7 -      |> LocalTheory.note Thm.theoremK
     9.8 +      |> LocalTheory.note Thm.generated_theoremK
     9.9             ((Binding.empty, [Attrib.internal (K add_elim_attrib)]), [th])
    9.10        |> snd
    9.11        |> LocalTheory.theory (prove_equation predname NONE)
    10.1 --- a/src/HOLCF/Tools/fixrec_package.ML	Sat May 16 15:24:35 2009 +0200
    10.2 +++ b/src/HOLCF/Tools/fixrec_package.ML	Sat May 16 20:17:59 2009 +0200
    10.3 @@ -195,7 +195,7 @@
    10.4      val unfold_thms = unfolds names tuple_unfold_thm;
    10.5      fun mk_note (n, thm) = ((Binding.name n, []), [thm]);
    10.6      val (thmss, lthy'') = lthy'
    10.7 -      |> fold_map (LocalTheory.note Thm.theoremK o mk_note)
    10.8 +      |> fold_map (LocalTheory.note Thm.generated_theoremK o mk_note)
    10.9          ((all_names ^ "_induct", tuple_induct_thm) :: unfold_thms);
   10.10    in
   10.11      (lthy'', names, fixdef_thms, map snd unfold_thms)
   10.12 @@ -373,7 +373,7 @@
   10.13        val simps2 : (Attrib.binding * thm list) list =
   10.14          map (apsnd (fn thm => [thm])) (List.concat simps);
   10.15        val (_, lthy'') = lthy'
   10.16 -        |> fold_map (LocalTheory.note Thm.theoremK) (simps1 @ simps2);
   10.17 +        |> fold_map (LocalTheory.note Thm.generated_theoremK) (simps1 @ simps2);
   10.18      in
   10.19        lthy''
   10.20      end
    11.1 --- a/src/Pure/Isar/attrib.ML	Sat May 16 15:24:35 2009 +0200
    11.2 +++ b/src/Pure/Isar/attrib.ML	Sat May 16 20:17:59 2009 +0200
    11.3 @@ -123,7 +123,7 @@
    11.4  
    11.5  fun attribute thy = attribute_i thy o intern_src thy;
    11.6  
    11.7 -fun eval_thms ctxt args = ProofContext.note_thmss Thm.theoremK
    11.8 +fun eval_thms ctxt args = ProofContext.note_thmss Thm.generated_theoremK
    11.9      [(Thm.empty_binding, args |> map (fn (a, atts) =>
   11.10          (ProofContext.get_fact ctxt a, map (attribute (ProofContext.theory_of ctxt)) atts)))] ctxt
   11.11    |> fst |> maps snd;
    12.1 --- a/src/Pure/Thy/thm_deps.ML	Sat May 16 15:24:35 2009 +0200
    12.2 +++ b/src/Pure/Thy/thm_deps.ML	Sat May 16 20:17:59 2009 +0200
    12.3 @@ -66,7 +66,7 @@
    12.4        case Thm.get_group thm of
    12.5          NONE => I | SOME grp => Symtab.update (grp, ())) thms Symtab.empty;
    12.6      val (thms', _) = fold (fn p as (s, thm) => fn q as (thms, grps') =>
    12.7 -      if member (op =) [Thm.theoremK, Thm.lemmaK, Thm.corollaryK, Thm.axiomK] (Thm.get_kind thm)
    12.8 +      if member (op =) [Thm.theoremK, Thm.generated_theoremK, Thm.lemmaK, Thm.corollaryK, Thm.axiomK] (Thm.get_kind thm)
    12.9          andalso is_unused p
   12.10        then
   12.11          (case Thm.get_group thm of
    13.1 --- a/src/Pure/more_thm.ML	Sat May 16 15:24:35 2009 +0200
    13.2 +++ b/src/Pure/more_thm.ML	Sat May 16 20:17:59 2009 +0200
    13.3 @@ -70,6 +70,7 @@
    13.4    val assumptionK: string
    13.5    val definitionK: string
    13.6    val theoremK: string
    13.7 +  val generated_theoremK : string
    13.8    val lemmaK: string
    13.9    val corollaryK: string
   13.10    val internalK: string
   13.11 @@ -388,6 +389,7 @@
   13.12  val assumptionK = "assumption";
   13.13  val definitionK = "definition";
   13.14  val theoremK = "theorem";
   13.15 +val generated_theoremK = "generated_theoremK"
   13.16  val lemmaK = "lemma";
   13.17  val corollaryK = "corollary";
   13.18  val internalK = Markup.internalK;