renamed Local_Theory.theory(_result) to Local_Theory.background_theory(_result) to emphasize that this belongs to the infrastructure and is rarely appropriate in user-space tools;
authorwenzelm
Thu, 26 Aug 2010 15:48:08 +0200
changeset 390322b3e054ae6fc
parent 39031 d07959fabde6
child 39033 f2cfb2cc03e8
renamed Local_Theory.theory(_result) to Local_Theory.background_theory(_result) to emphasize that this belongs to the infrastructure and is rarely appropriate in user-space tools;
src/HOL/Tools/Predicate_Compile/predicate_compile.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML
src/HOL/Tools/Quotient/quotient_typ.ML
src/HOL/Tools/typedef.ML
src/Pure/Isar/class.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/generic_target.ML
src/Pure/Isar/local_theory.ML
src/Pure/Isar/locale.ML
src/Pure/Isar/named_target.ML
src/Pure/Isar/overloading.ML
src/Pure/Isar/typedecl.ML
src/Pure/Thy/thy_load.ML
     1.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile.ML	Thu Aug 26 13:09:12 2010 +0200
     1.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile.ML	Thu Aug 26 15:48:08 2010 +0200
     1.3 @@ -176,9 +176,9 @@
     1.4       val t = Const (const, T)
     1.5       val options = extract_options (((expected_modes, proposed_modes), raw_options), const)
     1.6    in
     1.7 -    if (is_inductify options) then
     1.8 +    if is_inductify options then
     1.9        let
    1.10 -        val lthy' = Local_Theory.theory (preprocess options t) lthy
    1.11 +        val lthy' = Local_Theory.background_theory (preprocess options t) lthy
    1.12          val const =
    1.13            case Predicate_Compile_Fun.pred_of_function (ProofContext.theory_of lthy') const of
    1.14              SOME c => c
     2.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Aug 26 13:09:12 2010 +0200
     2.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Aug 26 15:48:08 2010 +0200
     2.3 @@ -3033,12 +3033,13 @@
     2.4      "adding alternative introduction rules for code generation of inductive predicates"
     2.5  
     2.6  (* TODO: make Theory_Data to Generic_Data & remove duplication of local theory and theory *)
     2.7 +(* FIXME ... this is important to avoid changing the background theory below *)
     2.8  fun generic_code_pred prep_const options raw_const lthy =
     2.9    let
    2.10      val thy = ProofContext.theory_of lthy
    2.11      val const = prep_const thy raw_const
    2.12      val ctxt = ProofContext.init_global thy
    2.13 -    val lthy' = Local_Theory.theory (PredData.map
    2.14 +    val lthy' = Local_Theory.background_theory (PredData.map
    2.15          (extend (fetch_pred_data ctxt) (depending_preds_of ctxt) const)) lthy
    2.16      val thy' = ProofContext.theory_of lthy'
    2.17      val ctxt' = ProofContext.init_global thy'
    2.18 @@ -3063,7 +3064,7 @@
    2.19          val global_thms = ProofContext.export goal_ctxt
    2.20            (ProofContext.init_global (ProofContext.theory_of goal_ctxt)) (map the_single thms)
    2.21        in
    2.22 -        goal_ctxt |> Local_Theory.theory (fold set_elim global_thms #>
    2.23 +        goal_ctxt |> Local_Theory.background_theory (fold set_elim global_thms #>
    2.24            ((case compilation options of
    2.25               Pred => add_equations
    2.26             | DSeq => add_dseq_equations
     3.1 --- a/src/HOL/Tools/Quotient/quotient_typ.ML	Thu Aug 26 13:09:12 2010 +0200
     3.2 +++ b/src/HOL/Tools/Quotient/quotient_typ.ML	Thu Aug 26 15:48:08 2010 +0200
     3.3 @@ -77,7 +77,8 @@
     3.4    Typedef.add_typedef false NONE (qty_name, vs, mx) 
     3.5      (typedef_term rel rty lthy) NONE typedef_tac lthy
     3.6  *)
     3.7 -   Local_Theory.theory_result
     3.8 +(* FIXME should really use local typedef here *)
     3.9 +   Local_Theory.background_theory_result
    3.10       (Typedef.add_typedef_global false NONE
    3.11         (qty_name, map (rpair dummyS) vs, mx)
    3.12           (typedef_term rel rty lthy)
     4.1 --- a/src/HOL/Tools/typedef.ML	Thu Aug 26 13:09:12 2010 +0200
     4.2 +++ b/src/HOL/Tools/typedef.ML	Thu Aug 26 15:48:08 2010 +0200
     4.3 @@ -186,7 +186,8 @@
     4.4            ||> Thm.term_of;
     4.5  
     4.6          val ((RepC, AbsC, axiom_name, axiom), axiom_lthy) = set_lthy |>
     4.7 -          Local_Theory.theory_result (primitive_typedef typedef_name newT oldT Rep_name Abs_name A);
     4.8 +          Local_Theory.background_theory_result
     4.9 +            (primitive_typedef typedef_name newT oldT Rep_name Abs_name A);
    4.10  
    4.11          val cert = Thm.cterm_of (ProofContext.theory_of axiom_lthy);
    4.12          val typedef =
    4.13 @@ -246,7 +247,7 @@
    4.14        in
    4.15          lthy2
    4.16          |> Local_Theory.declaration true (fn phi => put_info full_tname (transform_info phi info))
    4.17 -        |> Local_Theory.theory (Typedef_Interpretation.data full_tname)
    4.18 +        |> Local_Theory.background_theory (Typedef_Interpretation.data full_tname)
    4.19          |> pair (full_tname, info)
    4.20        end;
    4.21  
     5.1 --- a/src/Pure/Isar/class.ML	Thu Aug 26 13:09:12 2010 +0200
     5.2 +++ b/src/Pure/Isar/class.ML	Thu Aug 26 15:48:08 2010 +0200
     5.3 @@ -482,7 +482,7 @@
     5.4  
     5.5  val type_name = sanitize_name o Long_Name.base_name;
     5.6  
     5.7 -fun define_overloaded (c, U) v (b_def, rhs) = Local_Theory.theory_result
     5.8 +fun define_overloaded (c, U) v (b_def, rhs) = Local_Theory.background_theory_result
     5.9      (AxClass.declare_overloaded (c, U) ##>> AxClass.define_overloaded b_def (c, rhs))
    5.10    ##> (map_instantiation o apsnd) (filter_out (fn (_, (v', _)) => v' = v))
    5.11    ##> Local_Theory.target synchronize_inst_syntax;
    5.12 @@ -572,7 +572,7 @@
    5.13      val (tycos, vs, sort) = (#arities o the_instantiation) lthy;
    5.14      val arities_proof = maps (fn tyco => Logic.mk_arities (tyco, map snd vs, sort)) tycos;
    5.15      fun after_qed' results =
    5.16 -      Local_Theory.theory (fold (AxClass.add_arity o Thm.varifyT_global) results)
    5.17 +      Local_Theory.background_theory (fold (AxClass.add_arity o Thm.varifyT_global) results)
    5.18        #> after_qed;
    5.19    in
    5.20      lthy
     6.1 --- a/src/Pure/Isar/expression.ML	Thu Aug 26 13:09:12 2010 +0200
     6.2 +++ b/src/Pure/Isar/expression.ML	Thu Aug 26 15:48:08 2010 +0200
     6.3 @@ -824,8 +824,9 @@
     6.4      val goal_ctxt = fold Variable.auto_fixes eqns expr_ctxt;
     6.5      val export' = Variable.export_morphism goal_ctxt expr_ctxt;
     6.6  
     6.7 -    fun after_qed witss eqns = (ProofContext.background_theory o Context.theory_map)
     6.8 -      (note_eqns_register deps witss attrss eqns export export');
     6.9 +    fun after_qed witss eqns =
    6.10 +      (ProofContext.background_theory o Context.theory_map)
    6.11 +        (note_eqns_register deps witss attrss eqns export export');
    6.12  
    6.13    in Element.witness_proof_eqs after_qed propss eqns goal_ctxt end;
    6.14  
     7.1 --- a/src/Pure/Isar/generic_target.ML	Thu Aug 26 13:09:12 2010 +0200
     7.2 +++ b/src/Pure/Isar/generic_target.ML	Thu Aug 26 15:48:08 2010 +0200
     7.3 @@ -195,16 +195,16 @@
     7.4        (Morphism.transform (Local_Theory.global_morphism lthy) decl);
     7.5    in
     7.6      lthy
     7.7 -    |> Local_Theory.theory (Context.theory_map global_decl)
     7.8 +    |> Local_Theory.background_theory (Context.theory_map global_decl)
     7.9      |> Local_Theory.target (Context.proof_map global_decl)
    7.10    end;
    7.11  
    7.12  fun theory_foundation (((b, U), mx), (b_def, rhs)) (type_params, term_params) lthy =
    7.13    let
    7.14 -    val (const, lthy2) = lthy |> Local_Theory.theory_result
    7.15 +    val (const, lthy2) = lthy |> Local_Theory.background_theory_result
    7.16        (Sign.declare_const ((b, U), mx));
    7.17      val lhs = list_comb (const, type_params @ term_params);
    7.18 -    val ((_, def), lthy3) = lthy2 |> Local_Theory.theory_result
    7.19 +    val ((_, def), lthy3) = lthy2 |> Local_Theory.background_theory_result
    7.20        (Thm.add_def false false (b_def, Logic.mk_equals (lhs, rhs)));
    7.21    in ((lhs, def), lthy3) end;
    7.22  
    7.23 @@ -214,12 +214,13 @@
    7.24      val global_facts' = Attrib.map_facts (Attrib.attribute_i thy) global_facts;
    7.25    in
    7.26      lthy
    7.27 -    |> Local_Theory.theory (PureThy.note_thmss kind global_facts' #> snd)
    7.28 +    |> Local_Theory.background_theory (PureThy.note_thmss kind global_facts' #> snd)
    7.29      |> Local_Theory.target (ProofContext.note_thmss kind global_facts' #> snd)
    7.30    end;
    7.31  
    7.32 -fun theory_abbrev prmode ((b, mx), t) = Local_Theory.theory
    7.33 -  (Sign.add_abbrev (#1 prmode) (b, t) #->
    7.34 -    (fn (lhs, _) => Sign.notation true prmode [(lhs, mx)]));
    7.35 +fun theory_abbrev prmode ((b, mx), t) =
    7.36 +  Local_Theory.background_theory
    7.37 +    (Sign.add_abbrev (#1 prmode) (b, t) #->
    7.38 +      (fn (lhs, _) => Sign.notation true prmode [(lhs, mx)]));
    7.39  
    7.40  end;
     8.1 --- a/src/Pure/Isar/local_theory.ML	Thu Aug 26 13:09:12 2010 +0200
     8.2 +++ b/src/Pure/Isar/local_theory.ML	Thu Aug 26 15:48:08 2010 +0200
     8.3 @@ -21,8 +21,8 @@
     8.4    val target_of: local_theory -> Proof.context
     8.5    val raw_theory_result: (theory -> 'a * theory) -> local_theory -> 'a * local_theory
     8.6    val raw_theory: (theory -> theory) -> local_theory -> local_theory
     8.7 -  val theory_result: (theory -> 'a * theory) -> local_theory -> 'a * local_theory
     8.8 -  val theory: (theory -> theory) -> local_theory -> local_theory
     8.9 +  val background_theory_result: (theory -> 'a * theory) -> local_theory -> 'a * local_theory
    8.10 +  val background_theory: (theory -> theory) -> local_theory -> local_theory
    8.11    val target_result: (Proof.context -> 'a * Proof.context) -> local_theory -> 'a * local_theory
    8.12    val target: (Proof.context -> Proof.context) -> local_theory -> local_theory
    8.13    val map_contexts: (Context.generic -> Context.generic) -> local_theory -> local_theory
    8.14 @@ -144,7 +144,7 @@
    8.15  
    8.16  val checkpoint = raw_theory Theory.checkpoint;
    8.17  
    8.18 -fun theory_result f lthy =
    8.19 +fun background_theory_result f lthy =
    8.20    lthy |> raw_theory_result (fn thy =>
    8.21      thy
    8.22      |> Sign.map_naming (K (naming_of lthy))
    8.23 @@ -152,7 +152,7 @@
    8.24      ||> Sign.restore_naming thy
    8.25      ||> Theory.checkpoint);
    8.26  
    8.27 -fun theory f = #2 o theory_result (f #> pair ());
    8.28 +fun background_theory f = #2 o background_theory_result (f #> pair ());
    8.29  
    8.30  fun target_result f lthy =
    8.31    let
    8.32 @@ -169,7 +169,7 @@
    8.33  fun target f = #2 o target_result (f #> pair ());
    8.34  
    8.35  fun map_contexts f =
    8.36 -  theory (Context.theory_map f) #>
    8.37 +  background_theory (Context.theory_map f) #>
    8.38    target (Context.proof_map f) #>
    8.39    Context.proof_map f;
    8.40  
     9.1 --- a/src/Pure/Isar/locale.ML	Thu Aug 26 13:09:12 2010 +0200
     9.2 +++ b/src/Pure/Isar/locale.ML	Thu Aug 26 15:48:08 2010 +0200
     9.3 @@ -497,8 +497,8 @@
     9.4  fun add_thmss loc kind args ctxt =
     9.5    let
     9.6      val (Notes args', ctxt') = Element.activate_i (Notes (kind, args)) ctxt;
     9.7 -    val ctxt'' = ctxt' |> ProofContext.background_theory (
     9.8 -      (change_locale loc o apfst o apsnd) (cons (args', serial ()))
     9.9 +    val ctxt'' = ctxt' |> ProofContext.background_theory
    9.10 +     ((change_locale loc o apfst o apsnd) (cons (args', serial ()))
    9.11          #>
    9.12        (* Registrations *)
    9.13        (fn thy => fold_rev (fn (_, morph) =>
    10.1 --- a/src/Pure/Isar/named_target.ML	Thu Aug 26 13:09:12 2010 +0200
    10.2 +++ b/src/Pure/Isar/named_target.ML	Thu Aug 26 15:48:08 2010 +0200
    10.3 @@ -118,7 +118,7 @@
    10.4        (Element.morph_ctxt (Local_Theory.target_morphism lthy)) local_facts;
    10.5    in
    10.6      lthy
    10.7 -    |> Local_Theory.theory (PureThy.note_thmss kind global_facts' #> snd)
    10.8 +    |> Local_Theory.background_theory (PureThy.note_thmss kind global_facts' #> snd)
    10.9      |> Local_Theory.target (Locale.add_thmss locale kind local_facts')
   10.10    end
   10.11  
   10.12 @@ -129,19 +129,21 @@
   10.13  
   10.14  (* abbrev *)
   10.15  
   10.16 -fun locale_abbrev ta prmode ((b, mx), t) xs = Local_Theory.theory_result
   10.17 -  (Sign.add_abbrev Print_Mode.internal (b, t)) #->
   10.18 -    (fn (lhs, _) => locale_const_declaration ta prmode
   10.19 -      ((b, mx), Term.list_comb (Logic.unvarify_global lhs, xs)));
   10.20 +fun locale_abbrev ta prmode ((b, mx), t) xs =
   10.21 +  Local_Theory.background_theory_result
   10.22 +    (Sign.add_abbrev Print_Mode.internal (b, t)) #->
   10.23 +      (fn (lhs, _) => locale_const_declaration ta prmode
   10.24 +        ((b, mx), Term.list_comb (Logic.unvarify_global lhs, xs)));
   10.25  
   10.26  fun target_abbrev (ta as Target {target, is_locale, is_class, ...})
   10.27      prmode (b, mx) (global_rhs, t') xs lthy =
   10.28 -  if is_locale
   10.29 -    then lthy
   10.30 -      |> locale_abbrev ta prmode ((b, if is_class then NoSyn else mx), global_rhs) xs
   10.31 -      |> is_class ? Class.abbrev target prmode ((b, mx), t')
   10.32 -    else lthy
   10.33 -      |> Generic_Target.theory_abbrev prmode ((b, mx), global_rhs);
   10.34 +  if is_locale then
   10.35 +    lthy
   10.36 +    |> locale_abbrev ta prmode ((b, if is_class then NoSyn else mx), global_rhs) xs
   10.37 +    |> is_class ? Class.abbrev target prmode ((b, mx), t')
   10.38 +  else
   10.39 +    lthy
   10.40 +    |> Generic_Target.theory_abbrev prmode ((b, mx), global_rhs);
   10.41  
   10.42  
   10.43  (* pretty *)
   10.44 @@ -200,9 +202,10 @@
   10.45  
   10.46  fun init target thy = init_target (named_target thy target) thy;
   10.47  
   10.48 -fun reinit lthy = case peek lthy
   10.49 - of SOME {target, ...} => init target o Local_Theory.exit_global
   10.50 -  | NONE => error "Not in a named target";
   10.51 +fun reinit lthy =
   10.52 +  (case peek lthy of
   10.53 +    SOME {target, ...} => init target o Local_Theory.exit_global
   10.54 +  | NONE => error "Not in a named target");
   10.55  
   10.56  val theory_init = init_target global_target;
   10.57  
    11.1 --- a/src/Pure/Isar/overloading.ML	Thu Aug 26 13:09:12 2010 +0200
    11.2 +++ b/src/Pure/Isar/overloading.ML	Thu Aug 26 15:48:08 2010 +0200
    11.3 @@ -140,7 +140,7 @@
    11.4    end
    11.5  
    11.6  fun define_overloaded (c, U) (v, checked) (b_def, rhs) =
    11.7 -  Local_Theory.theory_result
    11.8 +  Local_Theory.background_theory_result
    11.9      (Thm.add_def (not checked) true (b_def, Logic.mk_equals (Const (c, Term.fastype_of rhs), rhs)))
   11.10    ##> map_overloading (filter_out (fn (_, (v', _)) => v' = v))
   11.11    ##> Local_Theory.target synchronize_syntax
    12.1 --- a/src/Pure/Isar/typedecl.ML	Thu Aug 26 13:09:12 2010 +0200
    12.2 +++ b/src/Pure/Isar/typedecl.ML	Thu Aug 26 15:48:08 2010 +0200
    12.3 @@ -34,7 +34,7 @@
    12.4  fun basic_decl decl (b, n, mx) lthy =
    12.5    let val name = Local_Theory.full_name lthy b in
    12.6      lthy
    12.7 -    |> Local_Theory.theory (decl name)
    12.8 +    |> Local_Theory.background_theory (decl name)
    12.9      |> Local_Theory.type_notation true Syntax.mode_default [(Type (name, replicate n dummyT), mx)]
   12.10      |> Local_Theory.type_alias b name
   12.11      |> pair name
    13.1 --- a/src/Pure/Thy/thy_load.ML	Thu Aug 26 13:09:12 2010 +0200
    13.2 +++ b/src/Pure/Thy/thy_load.ML	Thu Aug 26 15:48:08 2010 +0200
    13.3 @@ -195,7 +195,7 @@
    13.4        val _ = Context.>> Local_Theory.propagate_ml_env;
    13.5  
    13.6        val provide = provide (src_path, (path, id));
    13.7 -      val _ = Context.>> (Context.mapping provide (Local_Theory.theory provide));
    13.8 +      val _ = Context.>> (Context.mapping provide (Local_Theory.background_theory provide));
    13.9      in () end;
   13.10  
   13.11  fun exec_ml src_path = ML_Context.exec (fn () => use_ml src_path);