simplifier uses proper Proof.context instead of historic type simpset;
authorwenzelm
Thu Apr 18 17:07:01 2013 +0200 (2013-04-18)
changeset 517179e7d1c139569
parent 51709 19b47bfac6ef
child 51718 c18cf90cb392
simplifier uses proper Proof.context instead of historic type simpset;
NEWS
src/CCL/CCL.thy
src/CCL/Term.thy
src/CCL/Type.thy
src/Doc/Codegen/Further.thy
src/Doc/IsarImplementation/Isar.thy
src/Doc/IsarRef/Generic.thy
src/Doc/IsarRef/ML_Tactic.thy
src/Doc/Tutorial/Protocol/Message.thy
src/Doc/Tutorial/Protocol/Public.thy
src/FOL/FOL.thy
src/FOL/ex/Classical.thy
src/FOL/ex/Miniscope.thy
src/FOL/simpdata.ML
src/HOL/Algebra/ringsimp.ML
src/HOL/Auth/Message.thy
src/HOL/Auth/OtwayReesBella.thy
src/HOL/Auth/Public.thy
src/HOL/Auth/Shared.thy
src/HOL/Auth/Smartcard/ShoupRubin.thy
src/HOL/Auth/Smartcard/ShoupRubinBella.thy
src/HOL/Auth/Smartcard/Smartcard.thy
src/HOL/BNF/Tools/bnf_fp_def_sugar_tactics.ML
src/HOL/BNF/Tools/bnf_tactics.ML
src/HOL/BNF/Tools/bnf_wrap.ML
src/HOL/BNF/Tools/bnf_wrap_tactics.ML
src/HOL/Bali/AxExample.thy
src/HOL/Bali/AxSem.thy
src/HOL/Bali/Basis.thy
src/HOL/Bali/DefiniteAssignment.thy
src/HOL/Bali/Eval.thy
src/HOL/Bali/Evaln.thy
src/HOL/Bali/Example.thy
src/HOL/Bali/TypeSafe.thy
src/HOL/Bali/WellForm.thy
src/HOL/Bali/WellType.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Decision_Procs/Dense_Linear_Order.thy
src/HOL/Decision_Procs/commutative_ring_tac.ML
src/HOL/Decision_Procs/cooper_tac.ML
src/HOL/Decision_Procs/ferrack_tac.ML
src/HOL/Decision_Procs/ferrante_rackoff.ML
src/HOL/Decision_Procs/langford.ML
src/HOL/Decision_Procs/langford_data.ML
src/HOL/Decision_Procs/mir_tac.ML
src/HOL/Divides.thy
src/HOL/Fun.thy
src/HOL/HOL.thy
src/HOL/HOLCF/Cfun.thy
src/HOL/HOLCF/IOA/ABP/Correctness.thy
src/HOL/HOLCF/IOA/NTP/Impl.thy
src/HOL/HOLCF/IOA/meta_theory/Abstraction.thy
src/HOL/HOLCF/IOA/meta_theory/CompoScheds.thy
src/HOL/HOLCF/IOA/meta_theory/Sequence.thy
src/HOL/HOLCF/Lift.thy
src/HOL/HOLCF/Tools/Domain/domain_constructors.ML
src/HOL/HOLCF/Tools/Domain/domain_induction.ML
src/HOL/HOLCF/Tools/Domain/domain_isomorphism.ML
src/HOL/HOLCF/Tools/Domain/domain_take_proofs.ML
src/HOL/HOLCF/Tools/cont_proc.ML
src/HOL/HOLCF/Tools/fixrec.ML
src/HOL/HOLCF/Tr.thy
src/HOL/HOLCF/ex/Focus_ex.thy
src/HOL/HOLCF/ex/Pattern_Match.thy
src/HOL/Hoare/Hoare_Logic.thy
src/HOL/Hoare/Hoare_Logic_Abort.thy
src/HOL/Hoare/hoare_tac.ML
src/HOL/Hoare_Parallel/Gar_Coll.thy
src/HOL/Hoare_Parallel/Mul_Gar_Coll.thy
src/HOL/Hoare_Parallel/OG_Tactics.thy
src/HOL/IMPP/Hoare.thy
src/HOL/IOA/Solve.thy
src/HOL/Isar_Examples/Hoare.thy
src/HOL/Library/Extended_Nat.thy
src/HOL/Library/Sum_of_Squares/sum_of_squares.ML
src/HOL/Library/positivstellensatz.ML
src/HOL/Library/reflection.ML
src/HOL/List.thy
src/HOL/MicroJava/J/JTypeSafe.thy
src/HOL/MicroJava/J/WellForm.thy
src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/normarith.ML
src/HOL/NanoJava/Equivalence.thy
src/HOL/Nominal/nominal_atoms.ML
src/HOL/Nominal/nominal_datatype.ML
src/HOL/Nominal/nominal_fresh_fun.ML
src/HOL/Nominal/nominal_induct.ML
src/HOL/Nominal/nominal_inductive.ML
src/HOL/Nominal/nominal_inductive2.ML
src/HOL/Nominal/nominal_permeq.ML
src/HOL/Nominal/nominal_thmdecls.ML
src/HOL/Old_Number_Theory/Chinese.thy
src/HOL/Old_Number_Theory/WilsonBij.thy
src/HOL/Orderings.thy
src/HOL/Probability/measurable.ML
src/HOL/Product_Type.thy
src/HOL/Record_Benchmark/Record_Benchmark.thy
src/HOL/SET_Protocol/Message_SET.thy
src/HOL/SET_Protocol/Public_SET.thy
src/HOL/SPARK/Tools/spark_vcs.ML
src/HOL/Set.thy
src/HOL/Statespace/distinct_tree_prover.ML
src/HOL/Statespace/state_fun.ML
src/HOL/Statespace/state_space.ML
src/HOL/String.thy
src/HOL/TLA/Buffer/DBuffer.thy
src/HOL/TLA/Inc/Inc.thy
src/HOL/TLA/Memory/MemClerk.thy
src/HOL/TLA/Memory/Memory.thy
src/HOL/TLA/Memory/MemoryImplementation.thy
src/HOL/TLA/Memory/RPC.thy
src/HOL/TLA/TLA.thy
src/HOL/TPTP/atp_problem_import.ML
src/HOL/Tools/ATP/atp_problem_generate.ML
src/HOL/Tools/Datatype/datatype.ML
src/HOL/Tools/Datatype/datatype_codegen.ML
src/HOL/Tools/Datatype/datatype_realizer.ML
src/HOL/Tools/Datatype/rep_datatype.ML
src/HOL/Tools/Function/context_tree.ML
src/HOL/Tools/Function/function.ML
src/HOL/Tools/Function/function_core.ML
src/HOL/Tools/Function/induction_schema.ML
src/HOL/Tools/Function/lexicographic_order.ML
src/HOL/Tools/Function/mutual.ML
src/HOL/Tools/Function/partial_function.ML
src/HOL/Tools/Function/pat_completeness.ML
src/HOL/Tools/Function/scnp_reconstruct.ML
src/HOL/Tools/Function/size.ML
src/HOL/Tools/Function/sum_tree.ML
src/HOL/Tools/Meson/meson.ML
src/HOL/Tools/Meson/meson_clausify.ML
src/HOL/Tools/Metis/metis_tactic.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_pred.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML
src/HOL/Tools/Qelim/cooper.ML
src/HOL/Tools/Qelim/qelim.ML
src/HOL/Tools/Quickcheck/random_generators.ML
src/HOL/Tools/Quotient/quotient_tacs.ML
src/HOL/Tools/SMT/smt_normalize.ML
src/HOL/Tools/SMT/smt_real.ML
src/HOL/Tools/SMT/z3_proof_methods.ML
src/HOL/Tools/SMT/z3_proof_reconstruction.ML
src/HOL/Tools/SMT/z3_proof_tools.ML
src/HOL/Tools/TFL/post.ML
src/HOL/Tools/TFL/rules.ML
src/HOL/Tools/TFL/tfl.ML
src/HOL/Tools/arith_data.ML
src/HOL/Tools/enriched_type.ML
src/HOL/Tools/groebner.ML
src/HOL/Tools/inductive.ML
src/HOL/Tools/inductive_realizer.ML
src/HOL/Tools/inductive_set.ML
src/HOL/Tools/int_arith.ML
src/HOL/Tools/legacy_transfer.ML
src/HOL/Tools/lin_arith.ML
src/HOL/Tools/nat_numeral_simprocs.ML
src/HOL/Tools/numeral_simprocs.ML
src/HOL/Tools/recdef.ML
src/HOL/Tools/record.ML
src/HOL/Tools/semiring_normalizer.ML
src/HOL/Tools/set_comprehension_pointfree.ML
src/HOL/Tools/simpdata.ML
src/HOL/Tools/split_rule.ML
src/HOL/Transitive_Closure.thy
src/HOL/UNITY/Comp/Alloc.thy
src/HOL/UNITY/Simple/NSP_Bad.thy
src/HOL/UNITY/UNITY_Main.thy
src/HOL/UNITY/UNITY_tactics.ML
src/HOL/Word/Word.thy
src/HOL/Word/WordBitwise.thy
src/HOL/ex/Binary.thy
src/HOL/ex/Numeral_Representation.thy
src/HOL/ex/Records.thy
src/HOL/ex/Simproc_Tests.thy
src/Provers/Arith/assoc_fold.ML
src/Provers/Arith/cancel_div_mod.ML
src/Provers/Arith/cancel_numeral_factor.ML
src/Provers/Arith/cancel_numerals.ML
src/Provers/Arith/combine_numerals.ML
src/Provers/Arith/extract_common_term.ML
src/Provers/Arith/fast_lin_arith.ML
src/Provers/clasimp.ML
src/Provers/classical.ML
src/Provers/hypsubst.ML
src/Provers/quantifier1.ML
src/Provers/splitter.ML
src/Pure/Isar/code.ML
src/Pure/Isar/isar_cmd.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/local_defs.ML
src/Pure/Tools/find_theorems.ML
src/Pure/raw_simplifier.ML
src/Pure/simplifier.ML
src/Sequents/LK.thy
src/Sequents/LK/Nat.thy
src/Sequents/simpdata.ML
src/Tools/Code/code_preproc.ML
src/Tools/Code/code_simp.ML
src/Tools/eqsubst.ML
src/Tools/induct.ML
src/ZF/Datatype_ZF.thy
src/ZF/OrdQuant.thy
src/ZF/Tools/datatype_package.ML
src/ZF/Tools/inductive_package.ML
src/ZF/Tools/typechk.ML
src/ZF/UNITY/Constrains.thy
src/ZF/UNITY/SubstAx.thy
src/ZF/Univ.thy
src/ZF/arith_data.ML
src/ZF/int_arith.ML
src/ZF/pair.thy
     1.1 --- a/NEWS	Tue Apr 16 17:54:14 2013 +0200
     1.2 +++ b/NEWS	Thu Apr 18 17:07:01 2013 +0200
     1.3 @@ -134,6 +134,17 @@
     1.4  addEs, addDs etc. Note that claset_of and put_claset allow to manage
     1.5  clasets separately from the context.
     1.6  
     1.7 +* Simplifier tactics and tools use proper Proof.context instead of
     1.8 +historic type simpset.  Old-style declarations like addsimps,
     1.9 +addsimprocs etc. operate directly on Proof.context.  Raw type simpset
    1.10 +retains its use as snapshot of the main Simplifier context, using
    1.11 +simpset_of and put_simpset on Proof.context.  INCOMPATIBILITY -- port
    1.12 +old tools by making them depend on (ctxt : Proof.context) instead of
    1.13 +(ss : simpset), then turn (simpset_of ctxt) into ctxt.
    1.14 +
    1.15 +* Discontinued obsolete ML antiquotations @{claset} and @{simpset}.
    1.16 +INCOMPATIBILITY, use @{context} instead.
    1.17 +
    1.18  
    1.19  *** System ***
    1.20  
     2.1 --- a/src/CCL/CCL.thy	Tue Apr 16 17:54:14 2013 +0200
     2.2 +++ b/src/CCL/CCL.thy	Thu Apr 18 17:07:01 2013 +0200
     2.3 @@ -206,7 +206,7 @@
     2.4      in
     2.5        CHANGED (REPEAT (ares_tac [@{thm iffI}, @{thm allI}, @{thm conjI}] i ORELSE
     2.6          eresolve_tac inj_lemmas i ORELSE
     2.7 -        asm_simp_tac (simpset_of ctxt addsimps rews) i))
     2.8 +        asm_simp_tac (ctxt addsimps rews) i))
     2.9      end;
    2.10  *}
    2.11  
    2.12 @@ -281,7 +281,7 @@
    2.13        Goal.prove_global thy [] [] (Syntax.read_prop ctxt s)
    2.14          (fn _ =>
    2.15            rewrite_goals_tac defs THEN
    2.16 -          simp_tac (simpset_of ctxt addsimps (rls @ inj_rls)) 1)
    2.17 +          simp_tac (ctxt addsimps (rls @ inj_rls)) 1)
    2.18    in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end
    2.19  
    2.20  fun mkall_dstnct_thms ctxt defs i_rls xss = maps (mk_dstnct_thms ctxt defs i_rls) xss
    2.21 @@ -422,7 +422,7 @@
    2.22      REPEAT (rtac @{thm notI} 1 THEN
    2.23        dtac @{thm case_pocong} 1 THEN
    2.24        etac @{thm rev_mp} 5 THEN
    2.25 -      ALLGOALS (simp_tac @{simpset}) THEN
    2.26 +      ALLGOALS (simp_tac @{context}) THEN
    2.27        REPEAT (resolve_tac [@{thm po_refl}, @{thm npo_lam_bot}] 1)) *})
    2.28  
    2.29  lemmas npo_rls = npo_pair_lam npo_lam_pair npo_rls1
     3.1 --- a/src/CCL/Term.thy	Tue Apr 16 17:54:14 2013 +0200
     3.2 +++ b/src/CCL/Term.thy	Thu Apr 18 17:07:01 2013 +0200
     3.3 @@ -204,7 +204,7 @@
     3.4  method_setup beta_rl = {*
     3.5    Scan.succeed (fn ctxt =>
     3.6      SIMPLE_METHOD' (CHANGED o
     3.7 -      simp_tac (simpset_of ctxt addsimps @{thms rawBs} setloop (stac @{thm letrecB}))))
     3.8 +      simp_tac (ctxt addsimps @{thms rawBs} setloop (stac @{thm letrecB}))))
     3.9  *}
    3.10  
    3.11  lemma ifBtrue: "if true then t else u = t"
     4.1 --- a/src/CCL/Type.thy	Tue Apr 16 17:54:14 2013 +0200
     4.2 +++ b/src/CCL/Type.thy	Thu Apr 18 17:07:01 2013 +0200
     4.3 @@ -130,7 +130,7 @@
     4.4    SUBPROOF (fn {context = ctxt, prems = major :: prems, ...} =>
     4.5      resolve_tac ([major] RL top_crls) 1 THEN
     4.6      REPEAT_SOME (eresolve_tac (crls @ [@{thm exE}, @{thm bexE}, @{thm conjE}, @{thm disjE}])) THEN
     4.7 -    ALLGOALS (asm_simp_tac (simpset_of ctxt)) THEN
     4.8 +    ALLGOALS (asm_simp_tac ctxt) THEN
     4.9      ALLGOALS (ares_tac (prems RL [@{thm lem}]) ORELSE' etac @{thm bspec}) THEN
    4.10      safe_tac (ctxt addSIs prems))
    4.11  *}
    4.12 @@ -415,7 +415,7 @@
    4.13  ML {*
    4.14  fun genIs_tac ctxt genXH gen_mono =
    4.15    rtac (genXH RS @{thm iffD2}) THEN'
    4.16 -  simp_tac (simpset_of ctxt) THEN'
    4.17 +  simp_tac ctxt THEN'
    4.18    TRY o fast_tac
    4.19      (ctxt addIs [genXH RS @{thm iffD2}, gen_mono RS @{thm coinduct3_mono_lemma} RS @{thm lfpI}])
    4.20  *}
    4.21 @@ -498,7 +498,7 @@
    4.22   SELECT_GOAL
    4.23     (TRY (safe_tac ctxt) THEN
    4.24      resolve_tac ((rews @ [@{thm refl}]) RL ((rews @ [@{thm refl}]) RL [@{thm ssubst_pair}])) i THEN
    4.25 -    ALLGOALS (simp_tac (simpset_of ctxt)) THEN
    4.26 +    ALLGOALS (simp_tac ctxt) THEN
    4.27      ALLGOALS EQgen_raw_tac) i
    4.28  *}
    4.29  
     5.1 --- a/src/Doc/Codegen/Further.thy	Tue Apr 16 17:54:14 2013 +0200
     5.2 +++ b/src/Doc/Codegen/Further.thy	Thu Apr 18 17:07:01 2013 +0200
     5.3 @@ -255,8 +255,8 @@
     5.4    @{index_ML Code.read_const: "theory -> string -> string"} \\
     5.5    @{index_ML Code.add_eqn: "thm -> theory -> theory"} \\
     5.6    @{index_ML Code.del_eqn: "thm -> theory -> theory"} \\
     5.7 -  @{index_ML Code_Preproc.map_pre: "(simpset -> simpset) -> theory -> theory"} \\
     5.8 -  @{index_ML Code_Preproc.map_post: "(simpset -> simpset) -> theory -> theory"} \\
     5.9 +  @{index_ML Code_Preproc.map_pre: "(Proof.context -> Proof.context) -> theory -> theory"} \\
    5.10 +  @{index_ML Code_Preproc.map_post: "(Proof.context -> Proof.context) -> theory -> theory"} \\
    5.11    @{index_ML Code_Preproc.add_functrans: "
    5.12      string * (theory -> (thm * bool) list -> (thm * bool) list option)
    5.13        -> theory -> theory"} \\
     6.1 --- a/src/Doc/IsarImplementation/Isar.thy	Tue Apr 16 17:54:14 2013 +0200
     6.2 +++ b/src/Doc/IsarImplementation/Isar.thy	Thu Apr 18 17:07:01 2013 +0200
     6.3 @@ -385,7 +385,7 @@
     6.4    Attrib.thms >> (fn thms => fn ctxt =>
     6.5      SIMPLE_METHOD' (fn i =>
     6.6        CHANGED (asm_full_simp_tac
     6.7 -        (HOL_basic_ss addsimps thms) i)))
     6.8 +        (put_simpset HOL_basic_ss ctxt addsimps thms) i)))
     6.9  *} "rewrite subgoal by given rules"
    6.10  
    6.11  text {* The concrete syntax wrapping of @{command method_setup} always
    6.12 @@ -424,7 +424,7 @@
    6.13      SIMPLE_METHOD
    6.14        (CHANGED
    6.15          (ALLGOALS (asm_full_simp_tac
    6.16 -          (HOL_basic_ss addsimps thms)))))
    6.17 +          (put_simpset HOL_basic_ss ctxt addsimps thms)))))
    6.18  *} "rewrite all subgoals by given rules"
    6.19  
    6.20  notepad
    6.21 @@ -458,7 +458,8 @@
    6.22    Attrib.thms >> (fn thms => fn ctxt =>
    6.23      SIMPLE_METHOD' (fn i =>
    6.24        CHANGED (asm_full_simp_tac
    6.25 -        (HOL_basic_ss addsimps (thms @ My_Simps.get ctxt)) i)))
    6.26 +        (put_simpset HOL_basic_ss ctxt
    6.27 +          addsimps (thms @ My_Simps.get ctxt)) i)))
    6.28  *} "rewrite subgoal by given rules and my_simp rules from the context"
    6.29  
    6.30  text {*
     7.1 --- a/src/Doc/IsarRef/Generic.thy	Tue Apr 16 17:54:14 2013 +0200
     7.2 +++ b/src/Doc/IsarRef/Generic.thy	Thu Apr 18 17:07:01 2013 +0200
     7.3 @@ -996,9 +996,9 @@
     7.4  
     7.5  text {*
     7.6    \begin{mldecls}
     7.7 -  @{index_ML Simplifier.set_subgoaler: "(simpset -> int -> tactic) ->
     7.8 -  simpset -> simpset"} \\
     7.9 -  @{index_ML Simplifier.prems_of: "simpset -> thm list"} \\
    7.10 +  @{index_ML Simplifier.set_subgoaler: "(Proof.context -> int -> tactic) ->
    7.11 +  Proof.context -> Proof.context"} \\
    7.12 +  @{index_ML Simplifier.prems_of: "Proof.context -> thm list"} \\
    7.13    \end{mldecls}
    7.14  
    7.15    The subgoaler is the tactic used to solve subgoals arising out of
    7.16 @@ -1010,14 +1010,12 @@
    7.17  
    7.18    \begin{description}
    7.19  
    7.20 -  \item @{ML Simplifier.set_subgoaler}~@{text "ss tac"} sets the
    7.21 -  subgoaler of simpset @{text "ss"} to @{text "tac"}.  The tactic will
    7.22 -  be applied to the context of the running Simplifier instance,
    7.23 -  expressed as a simpset.
    7.24 +  \item @{ML Simplifier.set_subgoaler}~@{text "tac ctxt"} sets the
    7.25 +  subgoaler of the context to @{text "tac"}.  The tactic will
    7.26 +  be applied to the context of the running Simplifier instance.
    7.27  
    7.28 -  \item @{ML Simplifier.prems_of}~@{text "ss"} retrieves the current
    7.29 -  set of premises from simpset @{text "ss"} that represents the
    7.30 -  context of the running Simplifier.  This may be non-empty only if
    7.31 +  \item @{ML Simplifier.prems_of}~@{text "ctxt"} retrieves the current
    7.32 +  set of premises from the context.  This may be non-empty only if
    7.33    the Simplifier has been told to utilize local assumptions in the
    7.34    first place (cf.\ the options in \secref{sec:simp-meth}).
    7.35  
    7.36 @@ -1027,10 +1025,10 @@
    7.37  *}
    7.38  
    7.39  ML {*
    7.40 -  fun subgoaler_tac ss =
    7.41 +  fun subgoaler_tac ctxt =
    7.42      assume_tac ORELSE'
    7.43 -    resolve_tac (Simplifier.prems_of ss) ORELSE'
    7.44 -    asm_simp_tac ss
    7.45 +    resolve_tac (Simplifier.prems_of ctxt) ORELSE'
    7.46 +    asm_simp_tac ctxt
    7.47  *}
    7.48  
    7.49  text {* This tactic first tries to solve the subgoal by assumption or
    7.50 @@ -1043,12 +1041,12 @@
    7.51  text {*
    7.52    \begin{mldecls}
    7.53    @{index_ML_type solver} \\
    7.54 -  @{index_ML Simplifier.mk_solver: "string -> (simpset -> int -> tactic) ->
    7.55 -  solver"} \\
    7.56 -  @{index_ML_op setSolver: "simpset * solver -> simpset"} \\
    7.57 -  @{index_ML_op addSolver: "simpset * solver -> simpset"} \\
    7.58 -  @{index_ML_op setSSolver: "simpset * solver -> simpset"} \\
    7.59 -  @{index_ML_op addSSolver: "simpset * solver -> simpset"} \\
    7.60 +  @{index_ML Simplifier.mk_solver: "string ->
    7.61 +  (Proof.context -> int -> tactic) -> solver"} \\
    7.62 +  @{index_ML_op setSolver: "Proof.context * solver -> Proof.context"} \\
    7.63 +  @{index_ML_op addSolver: "Proof.context * solver -> Proof.context"} \\
    7.64 +  @{index_ML_op setSSolver: "Proof.context * solver -> Proof.context"} \\
    7.65 +  @{index_ML_op addSSolver: "Proof.context * solver -> Proof.context"} \\
    7.66    \end{mldecls}
    7.67  
    7.68    A solver is a tactic that attempts to solve a subgoal after
    7.69 @@ -1085,24 +1083,24 @@
    7.70    "tac"} into a solver; the @{text "name"} is only attached as a
    7.71    comment and has no further significance.
    7.72  
    7.73 -  \item @{text "ss setSSolver solver"} installs @{text "solver"} as
    7.74 -  the safe solver of @{text "ss"}.
    7.75 +  \item @{text "ctxt setSSolver solver"} installs @{text "solver"} as
    7.76 +  the safe solver of @{text "ctxt"}.
    7.77  
    7.78 -  \item @{text "ss addSSolver solver"} adds @{text "solver"} as an
    7.79 +  \item @{text "ctxt addSSolver solver"} adds @{text "solver"} as an
    7.80    additional safe solver; it will be tried after the solvers which had
    7.81 -  already been present in @{text "ss"}.
    7.82 +  already been present in @{text "ctxt"}.
    7.83  
    7.84 -  \item @{text "ss setSolver solver"} installs @{text "solver"} as the
    7.85 -  unsafe solver of @{text "ss"}.
    7.86 +  \item @{text "ctxt setSolver solver"} installs @{text "solver"} as the
    7.87 +  unsafe solver of @{text "ctxt"}.
    7.88  
    7.89 -  \item @{text "ss addSolver solver"} adds @{text "solver"} as an
    7.90 +  \item @{text "ctxt addSolver solver"} adds @{text "solver"} as an
    7.91    additional unsafe solver; it will be tried after the solvers which
    7.92 -  had already been present in @{text "ss"}.
    7.93 +  had already been present in @{text "ctxt"}.
    7.94  
    7.95    \end{description}
    7.96  
    7.97 -  \medskip The solver tactic is invoked with a simpset that represents
    7.98 -  the context of the running Simplifier.  Further simpset operations
    7.99 +  \medskip The solver tactic is invoked with the context of the
   7.100 +  running Simplifier.  Further operations
   7.101    may be used to retrieve relevant information, such as the list of
   7.102    local Simplifier premises via @{ML Simplifier.prems_of} --- this
   7.103    list may be non-empty only if the Simplifier runs in a mode that
   7.104 @@ -1144,14 +1142,18 @@
   7.105  
   7.106  text {*
   7.107    \begin{mldecls}
   7.108 -  @{index_ML_op setloop: "simpset * (int -> tactic) -> simpset"} \\
   7.109 -  @{index_ML_op setloop': "simpset * (simpset -> int -> tactic) -> simpset"} \\
   7.110 -  @{index_ML_op addloop: "simpset * (string * (int -> tactic)) -> simpset"} \\
   7.111 -  @{index_ML_op addloop': "simpset * (string * (simpset -> int -> tactic))
   7.112 -  -> simpset"} \\
   7.113 -  @{index_ML_op delloop: "simpset * string -> simpset"} \\
   7.114 -  @{index_ML_op Splitter.add_split: "thm -> simpset -> simpset"} \\
   7.115 -  @{index_ML_op Splitter.del_split: "thm -> simpset -> simpset"} \\
   7.116 +  @{index_ML_op setloop: "Proof.context *
   7.117 +  (int -> tactic) -> Proof.context"} \\
   7.118 +  @{index_ML_op setloop': "Proof.context *
   7.119 +  (Proof.context -> int -> tactic) -> Proof.context"} \\
   7.120 +  @{index_ML_op addloop: "Proof.context *
   7.121 +  (string * (int -> tactic)) -> Proof.context"} \\
   7.122 +  @{index_ML_op addloop': "Proof.context *
   7.123 +  (string * (Proof.context -> int -> tactic))
   7.124 +  -> Proof.context"} \\
   7.125 +  @{index_ML_op delloop: "Proof.context * string -> Proof.context"} \\
   7.126 +  @{index_ML Splitter.add_split: "thm -> Proof.context -> Proof.context"} \\
   7.127 +  @{index_ML Splitter.del_split: "thm -> Proof.context -> Proof.context"} \\
   7.128    \end{mldecls}
   7.129  
   7.130    The looper is a list of tactics that are applied after
   7.131 @@ -1166,28 +1168,26 @@
   7.132  
   7.133    \begin{description}
   7.134  
   7.135 -  \item @{text "ss setloop tac"} installs @{text "tac"} as the only
   7.136 -  looper tactic of @{text "ss"}.  The variant @{text "setloop'"}
   7.137 -  allows the tactic to depend on the running Simplifier context, which
   7.138 -  is represented as simpset.
   7.139 +  \item @{text "ctxt setloop tac"} installs @{text "tac"} as the only
   7.140 +  looper tactic of @{text "ctxt"}.  The variant @{text "setloop'"}
   7.141 +  allows the tactic to depend on the running Simplifier context.
   7.142  
   7.143 -  \item @{text "ss addloop (name, tac)"} adds @{text "tac"} as an
   7.144 +  \item @{text "ctxt addloop (name, tac)"} adds @{text "tac"} as an
   7.145    additional looper tactic with name @{text "name"}, which is
   7.146    significant for managing the collection of loopers.  The tactic will
   7.147    be tried after the looper tactics that had already been present in
   7.148 -  @{text "ss"}.  The variant @{text "addloop'"} allows the tactic to
   7.149 -  depend on the running Simplifier context, which is represented as
   7.150 -  simpset.
   7.151 +  @{text "ctxt"}.  The variant @{text "addloop'"} allows the tactic to
   7.152 +  depend on the running Simplifier context.
   7.153  
   7.154 -  \item @{text "ss delloop name"} deletes the looper tactic that was
   7.155 -  associated with @{text "name"} from @{text "ss"}.
   7.156 +  \item @{text "ctxt delloop name"} deletes the looper tactic that was
   7.157 +  associated with @{text "name"} from @{text "ctxt"}.
   7.158  
   7.159 -  \item @{ML Splitter.add_split}~@{text "thm ss"} adds split tactics
   7.160 -  for @{text "thm"} as additional looper tactics of @{text "ss"}.
   7.161 +  \item @{ML Splitter.add_split}~@{text "thm ctxt"} adds split tactics
   7.162 +  for @{text "thm"} as additional looper tactics of @{text "ctxt"}.
   7.163  
   7.164 -  \item @{ML Splitter.del_split}~@{text "thm ss"} deletes the split
   7.165 +  \item @{ML Splitter.del_split}~@{text "thm ctxt"} deletes the split
   7.166    tactic corresponding to @{text thm} from the looper tactics of
   7.167 -  @{text "ss"}.
   7.168 +  @{text "ctxt"}.
   7.169  
   7.170    \end{description}
   7.171  
   7.172 @@ -1817,16 +1817,16 @@
   7.173      @{index_ML_op addSWrapper: "Proof.context *
   7.174    (string * (Proof.context -> wrapper)) -> Proof.context"} \\
   7.175      @{index_ML_op addSbefore: "Proof.context *
   7.176 -  (string * (int -> tactic)) -> Proof.context"} \\
   7.177 +  (string * (Proof.context -> int -> tactic)) -> Proof.context"} \\
   7.178      @{index_ML_op addSafter: "Proof.context *
   7.179 -  (string * (int -> tactic)) -> Proof.context"} \\
   7.180 +  (string * (Proof.context -> int -> tactic)) -> Proof.context"} \\
   7.181      @{index_ML_op delSWrapper: "Proof.context * string -> Proof.context"} \\[0.5ex]
   7.182      @{index_ML_op addWrapper: "Proof.context *
   7.183    (string * (Proof.context -> wrapper)) -> Proof.context"} \\
   7.184      @{index_ML_op addbefore: "Proof.context *
   7.185 -  (string * (int -> tactic)) -> Proof.context"} \\
   7.186 +  (string * (Proof.context -> int -> tactic)) -> Proof.context"} \\
   7.187      @{index_ML_op addafter: "Proof.context *
   7.188 -  (string * (int -> tactic)) -> Proof.context"} \\
   7.189 +  (string * (Proof.context -> int -> tactic)) -> Proof.context"} \\
   7.190      @{index_ML_op delWrapper: "Proof.context * string -> Proof.context"} \\[0.5ex]
   7.191      @{index_ML addSss: "Proof.context -> Proof.context"} \\
   7.192      @{index_ML addss: "Proof.context -> Proof.context"} \\
     8.1 --- a/src/Doc/IsarRef/ML_Tactic.thy	Tue Apr 16 17:54:14 2013 +0200
     8.2 +++ b/src/Doc/IsarRef/ML_Tactic.thy	Thu Apr 18 17:07:01 2013 +0200
     8.3 @@ -88,12 +88,12 @@
     8.4  
     8.5    \medskip
     8.6    \begin{tabular}{lll}
     8.7 -    @{ML asm_full_simp_tac}~@{text "@{simpset} 1"} & & @{method simp} \\
     8.8 -    @{ML ALLGOALS}~(@{ML asm_full_simp_tac}~@{text "@{simpset}"}) & & @{method simp_all} \\[0.5ex]
     8.9 -    @{ML simp_tac}~@{text "@{simpset} 1"} & & @{method simp}~@{text "(no_asm)"} \\
    8.10 -    @{ML asm_simp_tac}~@{text "@{simpset} 1"} & & @{method simp}~@{text "(no_asm_simp)"} \\
    8.11 -    @{ML full_simp_tac}~@{text "@{simpset} 1"} & & @{method simp}~@{text "(no_asm_use)"} \\
    8.12 -    @{ML asm_lr_simp_tac}~@{text "@{simpset} 1"} & & @{method simp}~@{text "(asm_lr)"} \\
    8.13 +    @{ML asm_full_simp_tac}~@{text "@{context} 1"} & & @{method simp} \\
    8.14 +    @{ML ALLGOALS}~(@{ML asm_full_simp_tac}~@{text "@{context}"}) & & @{method simp_all} \\[0.5ex]
    8.15 +    @{ML simp_tac}~@{text "@{context} 1"} & & @{method simp}~@{text "(no_asm)"} \\
    8.16 +    @{ML asm_simp_tac}~@{text "@{context} 1"} & & @{method simp}~@{text "(no_asm_simp)"} \\
    8.17 +    @{ML full_simp_tac}~@{text "@{context} 1"} & & @{method simp}~@{text "(no_asm_use)"} \\
    8.18 +    @{ML asm_lr_simp_tac}~@{text "@{context} 1"} & & @{method simp}~@{text "(asm_lr)"} \\
    8.19    \end{tabular}
    8.20    \medskip
    8.21  *}
     9.1 --- a/src/Doc/Tutorial/Protocol/Message.thy	Tue Apr 16 17:54:14 2013 +0200
     9.2 +++ b/src/Doc/Tutorial/Protocol/Message.thy	Thu Apr 18 17:07:01 2013 +0200
     9.3 @@ -840,12 +840,12 @@
     9.4                    impOfSubs Fake_parts_insert] THEN'
     9.5      eresolve_tac [asm_rl, @{thm synth.Inj}];
     9.6  
     9.7 -fun Fake_insert_simp_tac ss i = 
     9.8 -  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
     9.9 +fun Fake_insert_simp_tac ctxt i = 
    9.10 +  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ctxt i;
    9.11  
    9.12  fun atomic_spy_analz_tac ctxt =
    9.13    SELECT_GOAL
    9.14 -   (Fake_insert_simp_tac (simpset_of ctxt) 1 THEN
    9.15 +   (Fake_insert_simp_tac ctxt 1 THEN
    9.16      IF_UNSOLVED (Blast.depth_tac (ctxt addIs [analz_insertI, impOfSubs analz_subset_parts]) 4 1));
    9.17  
    9.18  fun spy_analz_tac ctxt i =
    9.19 @@ -856,7 +856,7 @@
    9.20         (REPEAT o CHANGED)
    9.21             (res_inst_tac ctxt [(("x", 1), "X")] (insert_commute RS ssubst) 1),
    9.22         (*...allowing further simplifications*)
    9.23 -       simp_tac (simpset_of ctxt) 1,
    9.24 +       simp_tac ctxt 1,
    9.25         REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
    9.26         DEPTH_SOLVE (atomic_spy_analz_tac ctxt 1)]) i);
    9.27  *}
    9.28 @@ -914,7 +914,7 @@
    9.29      "for debugging spy_analz"
    9.30  
    9.31  method_setup Fake_insert_simp = {*
    9.32 -    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac o simpset_of) *}
    9.33 +    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac) *}
    9.34      "for debugging spy_analz"
    9.35  
    9.36  
    10.1 --- a/src/Doc/Tutorial/Protocol/Public.thy	Tue Apr 16 17:54:14 2013 +0200
    10.2 +++ b/src/Doc/Tutorial/Protocol/Public.thy	Thu Apr 18 17:07:01 2013 +0200
    10.3 @@ -159,7 +159,7 @@
    10.4  ML {*
    10.5  fun possibility_tac ctxt =
    10.6      REPEAT (*omit used_Says so that Nonces start from different traces!*)
    10.7 -    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [used_Says]))
    10.8 +    (ALLGOALS (simp_tac (ctxt delsimps [used_Says]))
    10.9       THEN
   10.10       REPEAT_FIRST (eq_assume_tac ORELSE' 
   10.11                     resolve_tac [refl, conjI, @{thm Nonce_supply}]));
    11.1 --- a/src/FOL/FOL.thy	Tue Apr 16 17:54:14 2013 +0200
    11.2 +++ b/src/FOL/FOL.thy	Thu Apr 18 17:07:01 2013 +0200
    11.3 @@ -331,16 +331,20 @@
    11.4  ML {*
    11.5  (*intuitionistic simprules only*)
    11.6  val IFOL_ss =
    11.7 -  FOL_basic_ss
    11.8 +  put_simpset FOL_basic_ss @{context}
    11.9    addsimps @{thms meta_simps IFOL_simps int_ex_simps int_all_simps}
   11.10    addsimprocs [@{simproc defined_All}, @{simproc defined_Ex}]
   11.11 -  |> Simplifier.add_cong @{thm imp_cong};
   11.12 +  |> Simplifier.add_cong @{thm imp_cong}
   11.13 +  |> simpset_of;
   11.14  
   11.15  (*classical simprules too*)
   11.16 -val FOL_ss = IFOL_ss addsimps @{thms cla_simps cla_ex_simps cla_all_simps};
   11.17 +val FOL_ss =
   11.18 +  put_simpset IFOL_ss @{context}
   11.19 +  addsimps @{thms cla_simps cla_ex_simps cla_all_simps}
   11.20 +  |> simpset_of;
   11.21  *}
   11.22  
   11.23 -setup {* Simplifier.map_simpset_global (K FOL_ss) *}
   11.24 +setup {* map_theory_simpset (put_simpset FOL_ss) *}
   11.25  
   11.26  setup "Simplifier.method_setup Splitter.split_modifiers"
   11.27  setup Splitter.setup
    12.1 --- a/src/FOL/ex/Classical.thy	Tue Apr 16 17:54:14 2013 +0200
    12.2 +++ b/src/FOL/ex/Classical.thy	Thu Apr 18 17:07:01 2013 +0200
    12.3 @@ -300,7 +300,7 @@
    12.4  
    12.5  (*Other proofs: Can use auto, which cheats by using rewriting!  
    12.6    Deepen_tac alone requires 253 secs.  Or
    12.7 -  by (mini_tac 1 THEN Deepen_tac 5 1) *)
    12.8 +  by (mini_tac @{context} 1 THEN Deepen_tac 5 1) *)
    12.9  
   12.10  text{*44*}
   12.11  lemma "(\<forall>x. f(x) --> (\<exists>y. g(y) & h(x,y) & (\<exists>y. g(y) & ~ h(x,y)))) &  
    13.1 --- a/src/FOL/ex/Miniscope.thy	Tue Apr 16 17:54:14 2013 +0200
    13.2 +++ b/src/FOL/ex/Miniscope.thy	Thu Apr 18 17:07:01 2013 +0200
    13.3 @@ -64,8 +64,8 @@
    13.4  lemmas mini_simps = demorgans nnf_simps ex_simps all_simps
    13.5  
    13.6  ML {*
    13.7 -val mini_ss = @{simpset} addsimps @{thms mini_simps};
    13.8 -val mini_tac = rtac @{thm ccontr} THEN' asm_full_simp_tac mini_ss;
    13.9 +val mini_ss = simpset_of (@{context} addsimps @{thms mini_simps});
   13.10 +fun mini_tac ctxt = rtac @{thm ccontr} THEN' asm_full_simp_tac (put_simpset mini_ss ctxt);
   13.11  *}
   13.12  
   13.13  end
    14.1 --- a/src/FOL/simpdata.ML	Tue Apr 16 17:54:14 2013 +0200
    14.2 +++ b/src/FOL/simpdata.ML	Thu Apr 18 17:07:01 2013 +0200
    14.3 @@ -26,8 +26,8 @@
    14.4        (REPEAT_FIRST (resolve_tac [@{thm meta_eq_to_obj_eq}, @{thm def_imp_iff}]));
    14.5  
    14.6  (*Congruence rules for = or <-> (instead of ==)*)
    14.7 -fun mk_meta_cong ss rl =
    14.8 -  Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems (Simplifier.the_context ss) rl))
    14.9 +fun mk_meta_cong ctxt rl =
   14.10 +  Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems ctxt rl))
   14.11      handle THM _ =>
   14.12        error("Premises and conclusion of congruence rules must use =-equality or <->");
   14.13  
   14.14 @@ -48,7 +48,7 @@
   14.15           | _ => [th])
   14.16    in atoms end;
   14.17  
   14.18 -fun mksimps pairs (_: simpset) = map mk_eq o mk_atomize pairs o gen_all;
   14.19 +fun mksimps pairs (_: Proof.context) = map mk_eq o mk_atomize pairs o gen_all;
   14.20  
   14.21  
   14.22  (** make simplification procedures for quantifier elimination **)
   14.23 @@ -106,25 +106,25 @@
   14.24  
   14.25  val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}];
   14.26  
   14.27 -fun unsafe_solver ss =
   14.28 -  FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ss), atac, etac @{thm FalseE}];
   14.29 +fun unsafe_solver ctxt =
   14.30 +  FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ctxt), atac, etac @{thm FalseE}];
   14.31  
   14.32  (*No premature instantiation of variables during simplification*)
   14.33 -fun safe_solver ss =
   14.34 -  FIRST' [match_tac (triv_rls @ Simplifier.prems_of ss), eq_assume_tac, ematch_tac @{thms FalseE}];
   14.35 +fun safe_solver ctxt =
   14.36 +  FIRST' [match_tac (triv_rls @ Simplifier.prems_of ctxt), eq_assume_tac, ematch_tac @{thms FalseE}];
   14.37  
   14.38  (*No simprules, but basic infastructure for simplification*)
   14.39  val FOL_basic_ss =
   14.40 -  Simplifier.global_context @{theory} empty_ss
   14.41 +  empty_simpset @{context}
   14.42    setSSolver (mk_solver "FOL safe" safe_solver)
   14.43    setSolver (mk_solver "FOL unsafe" unsafe_solver)
   14.44    |> Simplifier.set_subgoaler asm_simp_tac
   14.45    |> Simplifier.set_mksimps (mksimps mksimps_pairs)
   14.46 -  |> Simplifier.set_mkcong mk_meta_cong;
   14.47 +  |> Simplifier.set_mkcong mk_meta_cong
   14.48 +  |> simpset_of;
   14.49  
   14.50 -fun unfold_tac ths =
   14.51 -  let val ss0 = Simplifier.clear_ss FOL_basic_ss addsimps ths
   14.52 -  in fn ss => ALLGOALS (full_simp_tac (Simplifier.inherit_context ss ss0)) end;
   14.53 +fun unfold_tac ths ctxt =
   14.54 +  ALLGOALS (full_simp_tac (clear_simpset (put_simpset FOL_basic_ss ctxt) addsimps ths));
   14.55  
   14.56  
   14.57  (*** integration of simplifier with classical reasoner ***)
    15.1 --- a/src/HOL/Algebra/ringsimp.ML	Tue Apr 16 17:54:14 2013 +0200
    15.2 +++ b/src/HOL/Algebra/ringsimp.ML	Thu Apr 18 17:07:01 2013 +0200
    15.3 @@ -42,16 +42,16 @@
    15.4  
    15.5  (** Method **)
    15.6  
    15.7 -fun struct_tac ((s, ts), simps) =
    15.8 +fun struct_tac ctxt ((s, ts), simps) =
    15.9    let
   15.10      val ops = map (fst o Term.strip_comb) ts;
   15.11      fun ord (Const (a, _)) = find_index (fn (Const (b, _)) => a=b | _ => false) ops
   15.12        | ord (Free (a, _)) = find_index (fn (Free (b, _)) => a=b | _ => false) ops;
   15.13      fun less (a, b) = (Term_Ord.term_lpo ord (a, b) = LESS);
   15.14 -  in asm_full_simp_tac (HOL_ss addsimps simps |> Simplifier.set_termless less) end;
   15.15 +  in asm_full_simp_tac (put_simpset HOL_ss ctxt addsimps simps |> Simplifier.set_termless less) end;
   15.16  
   15.17  fun algebra_tac ctxt =
   15.18 -  EVERY' (map (fn s => TRY o struct_tac s) (Data.get (Context.Proof ctxt)));
   15.19 +  EVERY' (map (fn s => TRY o struct_tac ctxt s) (Data.get (Context.Proof ctxt)));
   15.20  
   15.21  
   15.22  (** Attribute **)
    16.1 --- a/src/HOL/Auth/Message.thy	Tue Apr 16 17:54:14 2013 +0200
    16.2 +++ b/src/HOL/Auth/Message.thy	Thu Apr 18 17:07:01 2013 +0200
    16.3 @@ -863,12 +863,12 @@
    16.4                    impOfSubs @{thm Fake_parts_insert}] THEN'
    16.5      eresolve_tac [asm_rl, @{thm synth.Inj}];
    16.6  
    16.7 -fun Fake_insert_simp_tac ss i = 
    16.8 -  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
    16.9 +fun Fake_insert_simp_tac ctxt i = 
   16.10 +  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ctxt i;
   16.11  
   16.12  fun atomic_spy_analz_tac ctxt =
   16.13    SELECT_GOAL
   16.14 -   (Fake_insert_simp_tac (simpset_of ctxt) 1 THEN
   16.15 +   (Fake_insert_simp_tac ctxt 1 THEN
   16.16      IF_UNSOLVED
   16.17        (Blast.depth_tac
   16.18          (ctxt addIs [@{thm analz_insertI}, impOfSubs @{thm analz_subset_parts}]) 4 1));
   16.19 @@ -881,7 +881,7 @@
   16.20         (REPEAT o CHANGED)
   16.21             (res_inst_tac ctxt [(("x", 1), "X")] (insert_commute RS ssubst) 1),
   16.22         (*...allowing further simplifications*)
   16.23 -       simp_tac (simpset_of ctxt) 1,
   16.24 +       simp_tac ctxt 1,
   16.25         REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
   16.26         DEPTH_SOLVE (atomic_spy_analz_tac ctxt 1)]) i);
   16.27  *}
   16.28 @@ -933,7 +933,7 @@
   16.29      "for debugging spy_analz"
   16.30  
   16.31  method_setup Fake_insert_simp = {*
   16.32 -    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac o simpset_of) *}
   16.33 +    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac) *}
   16.34      "for debugging spy_analz"
   16.35  
   16.36  end
    17.1 --- a/src/HOL/Auth/OtwayReesBella.thy	Tue Apr 16 17:54:14 2013 +0200
    17.2 +++ b/src/HOL/Auth/OtwayReesBella.thy	Thu Apr 18 17:07:01 2013 +0200
    17.3 @@ -237,10 +237,11 @@
    17.4  structure OtwayReesBella =
    17.5  struct
    17.6  
    17.7 -val analz_image_freshK_ss = 
    17.8 -  @{simpset} delsimps [image_insert, image_Un]
    17.9 +val analz_image_freshK_ss =
   17.10 +  simpset_of
   17.11 +   (@{context} delsimps [image_insert, image_Un]
   17.12        delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
   17.13 -      addsimps @{thms analz_image_freshK_simps}
   17.14 +      addsimps @{thms analz_image_freshK_simps})
   17.15  
   17.16  end
   17.17  *}
   17.18 @@ -251,7 +252,7 @@
   17.19        (EVERY [REPEAT_FIRST (resolve_tac [allI, ballI, impI]),
   17.20            REPEAT_FIRST (rtac @{thm analz_image_freshCryptK_lemma}),
   17.21            ALLGOALS (asm_simp_tac
   17.22 -            (Simplifier.context ctxt OtwayReesBella.analz_image_freshK_ss))]))) *}
   17.23 +            (put_simpset OtwayReesBella.analz_image_freshK_ss ctxt))]))) *}
   17.24    "for proving useful rewrite rule"
   17.25  
   17.26  
    18.1 --- a/src/HOL/Auth/Public.thy	Tue Apr 16 17:54:14 2013 +0200
    18.2 +++ b/src/HOL/Auth/Public.thy	Thu Apr 18 17:07:01 2013 +0200
    18.3 @@ -405,14 +405,16 @@
    18.4  structure Public =
    18.5  struct
    18.6  
    18.7 -val analz_image_freshK_ss = @{simpset} delsimps [image_insert, image_Un]
    18.8 -  delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
    18.9 -  addsimps @{thms analz_image_freshK_simps}
   18.10 +val analz_image_freshK_ss =
   18.11 +  simpset_of
   18.12 +   (@{context} delsimps [image_insert, image_Un]
   18.13 +    delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
   18.14 +    addsimps @{thms analz_image_freshK_simps})
   18.15  
   18.16  (*Tactic for possibility theorems*)
   18.17  fun possibility_tac ctxt =
   18.18      REPEAT (*omit used_Says so that Nonces start from different traces!*)
   18.19 -    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}]))
   18.20 +    (ALLGOALS (simp_tac (ctxt delsimps [@{thm used_Says}]))
   18.21       THEN
   18.22       REPEAT_FIRST (eq_assume_tac ORELSE' 
   18.23                     resolve_tac [refl, conjI, @{thm Nonce_supply}]))
   18.24 @@ -421,7 +423,7 @@
   18.25    nonces and keys initially*)
   18.26  fun basic_possibility_tac ctxt =
   18.27      REPEAT 
   18.28 -    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
   18.29 +    (ALLGOALS (asm_simp_tac (ctxt setSolver safe_solver))
   18.30       THEN
   18.31       REPEAT_FIRST (resolve_tac [refl, conjI]))
   18.32  
   18.33 @@ -433,7 +435,7 @@
   18.34       (SIMPLE_METHOD
   18.35        (EVERY [REPEAT_FIRST (resolve_tac [allI, ballI, impI]),
   18.36            REPEAT_FIRST (rtac @{thm analz_image_freshK_lemma}),
   18.37 -          ALLGOALS (asm_simp_tac (Simplifier.context ctxt Public.analz_image_freshK_ss))]))) *}
   18.38 +          ALLGOALS (asm_simp_tac (put_simpset Public.analz_image_freshK_ss ctxt))]))) *}
   18.39      "for proving the Session Key Compromise theorem"
   18.40  
   18.41  
    19.1 --- a/src/HOL/Auth/Shared.thy	Tue Apr 16 17:54:14 2013 +0200
    19.2 +++ b/src/HOL/Auth/Shared.thy	Thu Apr 18 17:07:01 2013 +0200
    19.3 @@ -200,7 +200,7 @@
    19.4      such as  Nonce ?N \<notin> used evs that match Nonce_supply*)
    19.5  fun possibility_tac ctxt =
    19.6     (REPEAT 
    19.7 -    (ALLGOALS (simp_tac (simpset_of ctxt
    19.8 +    (ALLGOALS (simp_tac (ctxt
    19.9            delsimps [@{thm used_Says}, @{thm used_Notes}, @{thm used_Gets}] 
   19.10            setSolver safe_solver))
   19.11       THEN
   19.12 @@ -211,15 +211,16 @@
   19.13    nonces and keys initially*)
   19.14  fun basic_possibility_tac ctxt =
   19.15      REPEAT 
   19.16 -    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
   19.17 +    (ALLGOALS (asm_simp_tac (ctxt setSolver safe_solver))
   19.18       THEN
   19.19       REPEAT_FIRST (resolve_tac [refl, conjI]))
   19.20  
   19.21  
   19.22  val analz_image_freshK_ss =
   19.23 -  @{simpset} delsimps [image_insert, image_Un]
   19.24 +  simpset_of
   19.25 +   (@{context} delsimps [image_insert, image_Un]
   19.26        delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
   19.27 -      addsimps @{thms analz_image_freshK_simps}
   19.28 +      addsimps @{thms analz_image_freshK_simps})
   19.29  
   19.30  end
   19.31  *}
   19.32 @@ -238,7 +239,7 @@
   19.33       (SIMPLE_METHOD
   19.34        (EVERY [REPEAT_FIRST (resolve_tac [allI, ballI, impI]),
   19.35            REPEAT_FIRST (rtac @{thm analz_image_freshK_lemma}),
   19.36 -          ALLGOALS (asm_simp_tac (Simplifier.context ctxt Shared.analz_image_freshK_ss))]))) *}
   19.37 +          ALLGOALS (asm_simp_tac (put_simpset Shared.analz_image_freshK_ss ctxt))]))) *}
   19.38      "for proving the Session Key Compromise theorem"
   19.39  
   19.40  method_setup possibility = {*
    20.1 --- a/src/HOL/Auth/Smartcard/ShoupRubin.thy	Tue Apr 16 17:54:14 2013 +0200
    20.2 +++ b/src/HOL/Auth/Smartcard/ShoupRubin.thy	Thu Apr 18 17:07:01 2013 +0200
    20.3 @@ -819,7 +819,7 @@
    20.4        (EVERY [REPEAT_FIRST
    20.5         (resolve_tac [allI, ballI, impI]),
    20.6          REPEAT_FIRST (rtac @{thm analz_image_freshK_lemma}),
    20.7 -        ALLGOALS (asm_simp_tac (Simplifier.context ctxt Smartcard.analz_image_freshK_ss
    20.8 +        ALLGOALS (asm_simp_tac (put_simpset Smartcard.analz_image_freshK_ss ctxt
    20.9            addsimps [@{thm knows_Spy_Inputs_secureM_sr_Spy},
   20.10                      @{thm knows_Spy_Outpts_secureM_sr_Spy},
   20.11                      @{thm shouprubin_assumes_securemeans}, 
    21.1 --- a/src/HOL/Auth/Smartcard/ShoupRubinBella.thy	Tue Apr 16 17:54:14 2013 +0200
    21.2 +++ b/src/HOL/Auth/Smartcard/ShoupRubinBella.thy	Thu Apr 18 17:07:01 2013 +0200
    21.3 @@ -828,7 +828,7 @@
    21.4       (SIMPLE_METHOD
    21.5        (EVERY [REPEAT_FIRST (resolve_tac [allI, ballI, impI]),
    21.6            REPEAT_FIRST (rtac @{thm analz_image_freshK_lemma}),
    21.7 -          ALLGOALS (asm_simp_tac (Simplifier.context ctxt Smartcard.analz_image_freshK_ss
    21.8 +          ALLGOALS (asm_simp_tac (put_simpset Smartcard.analz_image_freshK_ss ctxt
    21.9                addsimps [@{thm knows_Spy_Inputs_secureM_srb_Spy},
   21.10                    @{thm knows_Spy_Outpts_secureM_srb_Spy},
   21.11                    @{thm shouprubin_assumes_securemeans},
    22.1 --- a/src/HOL/Auth/Smartcard/Smartcard.thy	Tue Apr 16 17:54:14 2013 +0200
    22.2 +++ b/src/HOL/Auth/Smartcard/Smartcard.thy	Thu Apr 18 17:07:01 2013 +0200
    22.3 @@ -369,9 +369,9 @@
    22.4      such as  Nonce ?N \<notin> used evs that match Nonce_supply*)
    22.5  fun possibility_tac ctxt =
    22.6     (REPEAT 
    22.7 -    (ALLGOALS (simp_tac (simpset_of ctxt
    22.8 +    (ALLGOALS (simp_tac (ctxt
    22.9        delsimps [@{thm used_Says}, @{thm used_Notes}, @{thm used_Gets},
   22.10 -        @{thm used_Inputs}, @{thm used_C_Gets}, @{thm used_Outpts}, @{thm used_A_Gets}] 
   22.11 +        @{thm used_Inputs}, @{thm used_C_Gets}, @{thm used_Outpts}, @{thm used_A_Gets}]
   22.12        setSolver safe_solver))
   22.13       THEN
   22.14       REPEAT_FIRST (eq_assume_tac ORELSE' 
   22.15 @@ -381,14 +381,15 @@
   22.16    nonces and keys initially*)
   22.17  fun basic_possibility_tac ctxt =
   22.18      REPEAT 
   22.19 -    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
   22.20 +    (ALLGOALS (asm_simp_tac (ctxt setSolver safe_solver))
   22.21       THEN
   22.22       REPEAT_FIRST (resolve_tac [refl, conjI]))
   22.23  
   22.24  val analz_image_freshK_ss = 
   22.25 -     @{simpset} delsimps [image_insert, image_Un]
   22.26 +  simpset_of
   22.27 +   (@{context} delsimps [image_insert, image_Un]
   22.28                 delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
   22.29 -               addsimps @{thms analz_image_freshK_simps}
   22.30 +               addsimps @{thms analz_image_freshK_simps})
   22.31  end
   22.32  *}
   22.33  
   22.34 @@ -405,7 +406,7 @@
   22.35       (SIMPLE_METHOD
   22.36        (EVERY [REPEAT_FIRST (resolve_tac [allI, ballI, impI]),
   22.37            REPEAT_FIRST (rtac @{thm analz_image_freshK_lemma}),
   22.38 -          ALLGOALS (asm_simp_tac (Simplifier.context ctxt Smartcard.analz_image_freshK_ss))]))) *}
   22.39 +          ALLGOALS (asm_simp_tac (put_simpset Smartcard.analz_image_freshK_ss ctxt))]))) *}
   22.40      "for proving the Session Key Compromise theorem"
   22.41  
   22.42  method_setup possibility = {*
    23.1 --- a/src/HOL/BNF/Tools/bnf_fp_def_sugar_tactics.ML	Tue Apr 16 17:54:14 2013 +0200
    23.2 +++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar_tactics.ML	Thu Apr 18 17:07:01 2013 +0200
    23.3 @@ -46,7 +46,7 @@
    23.4  val sum_prod_thms_set = @{thms UN_compreh_eq_eq} @ sum_prod_thms_set0;
    23.5  val sum_prod_thms_rel = @{thms prod_rel_simp sum_rel_simps};
    23.6  
    23.7 -val ss_if_True_False = ss_only @{thms if_True if_False};
    23.8 +val ss_if_True_False = simpset_of (ss_only @{thms if_True if_False} @{context});
    23.9  
   23.10  fun mk_proj T k =
   23.11    let val binders = binder_types T in
   23.12 @@ -115,7 +115,8 @@
   23.13  fun mk_corec_like_tac corec_like_defs map_comps'' map_comp's map_ids'' map_if_distribs
   23.14      ctor_dtor_corec_like pre_map_def ctr_def ctxt =
   23.15    unfold_thms_tac ctxt (ctr_def :: corec_like_defs) THEN
   23.16 -  (rtac (ctor_dtor_corec_like RS trans) THEN' asm_simp_tac ss_if_True_False) 1 THEN_MAYBE
   23.17 +  (rtac (ctor_dtor_corec_like RS trans) THEN'
   23.18 +    asm_simp_tac (put_simpset ss_if_True_False ctxt)) 1 THEN_MAYBE
   23.19    (unfold_thms_tac ctxt (pre_map_def :: map_comp's @ map_comps'' @ map_ids'' @ map_if_distribs @
   23.20      corec_like_unfold_thms) THEN
   23.21     (rtac refl ORELSE' rtac (@{thm unit_eq} RS arg_cong)) 1);
   23.22 @@ -123,7 +124,7 @@
   23.23  fun mk_disc_corec_like_iff_tac case_splits' corec_likes discs ctxt =
   23.24    EVERY (map3 (fn case_split_tac => fn corec_like_thm => fn disc =>
   23.25        case_split_tac 1 THEN unfold_thms_tac ctxt [corec_like_thm] THEN
   23.26 -      asm_simp_tac (ss_only basic_simp_thms) 1 THEN
   23.27 +      asm_simp_tac (ss_only basic_simp_thms ctxt) 1 THEN
   23.28        (if is_refl disc then all_tac else rtac disc 1))
   23.29      (map rtac case_splits' @ [K all_tac]) corec_likes discs);
   23.30  
   23.31 @@ -162,12 +163,12 @@
   23.32    SELECT_GOAL (unfold_thms_tac ctxt (pre_rel_def :: dtor_ctor :: sels @ sum_prod_thms_rel)) THEN'
   23.33    (atac ORELSE' REPEAT o etac conjE THEN'
   23.34       full_simp_tac
   23.35 -       (ss_only (@{thm prod.inject} :: no_refl discs @ rel_eqs @ more_simp_thms)) THEN_MAYBE'
   23.36 +       (ss_only (@{thm prod.inject} :: no_refl discs @ rel_eqs @ more_simp_thms) ctxt) THEN_MAYBE'
   23.37       REPEAT o hyp_subst_tac THEN' REPEAT o rtac conjI THEN' REPEAT o rtac refl);
   23.38  
   23.39 -fun mk_coinduct_distinct_ctrs discs discs' =
   23.40 +fun mk_coinduct_distinct_ctrs ctxt discs discs' =
   23.41    hyp_subst_tac THEN' REPEAT o etac conjE THEN'
   23.42 -  full_simp_tac (ss_only (refl :: no_refl (discs @ discs') @ basic_simp_thms));
   23.43 +  full_simp_tac (ss_only (refl :: no_refl (discs @ discs') @ basic_simp_thms) ctxt);
   23.44  
   23.45  fun mk_coinduct_discharge_prem_tac ctxt rel_eqs' nn kk n pre_rel_def dtor_ctor exhaust ctr_defs
   23.46      discss selss =
   23.47 @@ -180,7 +181,7 @@
   23.48              if k' = k then
   23.49                mk_coinduct_same_ctr ctxt rel_eqs' pre_rel_def dtor_ctor ctr_def discs sels
   23.50              else
   23.51 -              mk_coinduct_distinct_ctrs discs discs') ks discss)) ks ctr_defs discss selss)
   23.52 +              mk_coinduct_distinct_ctrs ctxt discs discs') ks discss)) ks ctr_defs discss selss)
   23.53    end;
   23.54  
   23.55  fun mk_coinduct_tac ctxt rel_eqs' nn ns dtor_coinduct' pre_rel_defs dtor_ctors exhausts ctr_defss
    24.1 --- a/src/HOL/BNF/Tools/bnf_tactics.ML	Tue Apr 16 17:54:14 2013 +0200
    24.2 +++ b/src/HOL/BNF/Tools/bnf_tactics.ML	Thu Apr 18 17:07:01 2013 +0200
    24.3 @@ -8,7 +8,7 @@
    24.4  
    24.5  signature BNF_TACTICS =
    24.6  sig
    24.7 -  val ss_only: thm list -> simpset
    24.8 +  val ss_only : thm list -> Proof.context -> Proof.context
    24.9  
   24.10    val select_prem_tac: int -> (int -> tactic) -> int -> int -> tactic
   24.11    val fo_rtac: thm -> Proof.context -> int -> tactic
   24.12 @@ -36,7 +36,7 @@
   24.13  
   24.14  open BNF_Util
   24.15  
   24.16 -fun ss_only thms = Simplifier.clear_ss HOL_basic_ss addsimps thms;
   24.17 +fun ss_only ths ctxt = clear_simpset (put_simpset HOL_basic_ss ctxt) addsimps ths
   24.18  
   24.19  fun select_prem_tac n tac k = DETERM o (EVERY' [REPEAT_DETERM_N (k - 1) o etac thin_rl,
   24.20    tac, REPEAT_DETERM_N (n - k) o etac thin_rl]);
    25.1 --- a/src/HOL/BNF/Tools/bnf_wrap.ML	Tue Apr 16 17:54:14 2013 +0200
    25.2 +++ b/src/HOL/BNF/Tools/bnf_wrap.ML	Thu Apr 18 17:07:01 2013 +0200
    25.3 @@ -540,7 +540,7 @@
    25.4                      map (fn NONE => Drule.dummy_thm | SOME thm => thm RS sym) collapse_thm_opts;
    25.5                  in
    25.6                    [Goal.prove_sorry lthy [] [] goal (fn _ =>
    25.7 -                     mk_expand_tac n ms (inst_thm u disc_exhaust_thm)
    25.8 +                     mk_expand_tac lthy n ms (inst_thm u disc_exhaust_thm)
    25.9                         (inst_thm v disc_exhaust_thm) uncollapse_thms disc_exclude_thmsss
   25.10                         disc_exclude_thmsss')]
   25.11                    |> map Thm.close_derivation
   25.12 @@ -573,7 +573,7 @@
   25.13                   mk_Trueprop_eq (ufcase, vgcase));
   25.14              val weak_goal = Logic.mk_implies (uv_eq, mk_Trueprop_eq (ufcase, vfcase));
   25.15            in
   25.16 -            (Goal.prove_sorry lthy [] [] goal (fn _ => mk_case_cong_tac uexhaust_thm case_thms),
   25.17 +            (Goal.prove_sorry lthy [] [] goal (fn _ => mk_case_cong_tac lthy uexhaust_thm case_thms),
   25.18               Goal.prove_sorry lthy [] [] weak_goal (K (etac arg_cong 1)))
   25.19              |> pairself (Thm.close_derivation #> singleton (Proof_Context.export names_lthy lthy))
   25.20            end;
   25.21 @@ -596,7 +596,7 @@
   25.22  
   25.23              val split_thm =
   25.24                Goal.prove_sorry lthy [] [] goal
   25.25 -                (fn _ => mk_split_tac uexhaust_thm case_thms inject_thmss distinct_thmsss)
   25.26 +                (fn _ => mk_split_tac lthy uexhaust_thm case_thms inject_thmss distinct_thmsss)
   25.27                |> Thm.close_derivation
   25.28                |> singleton (Proof_Context.export names_lthy lthy);
   25.29              val split_asm_thm =
    26.1 --- a/src/HOL/BNF/Tools/bnf_wrap_tactics.ML	Tue Apr 16 17:54:14 2013 +0200
    26.2 +++ b/src/HOL/BNF/Tools/bnf_wrap_tactics.ML	Thu Apr 18 17:07:01 2013 +0200
    26.3 @@ -8,17 +8,18 @@
    26.4  signature BNF_WRAP_TACTICS =
    26.5  sig
    26.6    val mk_alternate_disc_def_tac: Proof.context -> int -> thm -> thm -> thm -> tactic
    26.7 -  val mk_case_cong_tac: thm -> thm list -> tactic
    26.8 +  val mk_case_cong_tac: Proof.context -> thm -> thm list -> tactic
    26.9    val mk_case_conv_tac: Proof.context -> int -> thm -> thm list -> thm list list -> thm list list ->
   26.10      tactic
   26.11    val mk_collapse_tac: Proof.context -> int -> thm -> thm list -> tactic
   26.12    val mk_disc_exhaust_tac: int -> thm -> thm list -> tactic
   26.13 -  val mk_expand_tac: int -> int list -> thm -> thm -> thm list -> thm list list list ->
   26.14 -    thm list list list -> tactic
   26.15 +  val mk_expand_tac: Proof.context -> int -> int list -> thm -> thm -> thm list ->
   26.16 +    thm list list list -> thm list list list -> tactic
   26.17    val mk_half_disc_exclude_tac: int -> thm -> thm -> tactic
   26.18    val mk_nchotomy_tac: int -> thm -> tactic
   26.19    val mk_other_half_disc_exclude_tac: thm -> tactic
   26.20 -  val mk_split_tac: thm -> thm list -> thm list list -> thm list list list -> tactic
   26.21 +  val mk_split_tac: Proof.context ->
   26.22 +    thm -> thm list -> thm list list -> thm list list list -> tactic
   26.23    val mk_split_asm_tac: Proof.context -> thm -> tactic
   26.24    val mk_unique_disc_def_tac: int -> thm -> tactic
   26.25  end;
   26.26 @@ -66,7 +67,8 @@
   26.27        REPEAT_DETERM_N m o etac exE THEN' hyp_subst_tac THEN'
   26.28        SELECT_GOAL (unfold_thms_tac ctxt sels) THEN' rtac refl)) 1;
   26.29  
   26.30 -fun mk_expand_tac n ms udisc_exhaust vdisc_exhaust uncollapses disc_excludesss disc_excludesss' =
   26.31 +fun mk_expand_tac ctxt
   26.32 +    n ms udisc_exhaust vdisc_exhaust uncollapses disc_excludesss disc_excludesss' =
   26.33    if ms = [0] then
   26.34      rtac (@{thm trans_sym} OF (replicate 2 (the_single uncollapses RS sym))) 1
   26.35    else
   26.36 @@ -86,7 +88,8 @@
   26.37                    else
   26.38                      [rtac (vuncollapse RS trans), maybe_atac,
   26.39                       if n = 1 then K all_tac else EVERY' [dtac meta_mp, atac, dtac meta_mp, atac],
   26.40 -                     REPEAT_DETERM_N (Int.max (0, m - 1)) o etac conjE, asm_simp_tac (ss_only [])]
   26.41 +                     REPEAT_DETERM_N (Int.max (0, m - 1)) o etac conjE,
   26.42 +                     asm_simp_tac (ss_only [] ctxt)]
   26.43                  else
   26.44                    [dtac (the_single (if k = n then disc_excludes else disc_excludes')),
   26.45                     etac (if k = n then @{thm iff_contradict(1)} else @{thm iff_contradict(2)}),
   26.46 @@ -101,18 +104,18 @@
   26.47         EVERY' [hyp_subst_tac, SELECT_GOAL (unfold_thms_tac ctxt (if_discs @ sels)), rtac casex])
   26.48       cases (map2 (seq_conds if_P_or_not_P_OF n) (1 upto n) discss') selss)) 1;
   26.49  
   26.50 -fun mk_case_cong_tac uexhaust cases =
   26.51 +fun mk_case_cong_tac ctxt uexhaust cases =
   26.52    (rtac uexhaust THEN'
   26.53 -   EVERY' (maps (fn casex => [dtac sym, asm_simp_tac (ss_only [casex])]) cases)) 1;
   26.54 +   EVERY' (maps (fn casex => [dtac sym, asm_simp_tac (ss_only [casex] ctxt)]) cases)) 1;
   26.55  
   26.56  val naked_ctxt = @{theory_context HOL};
   26.57  
   26.58  (* TODO: More precise "simp_thms"; get rid of "blast_tac" *)
   26.59 -fun mk_split_tac uexhaust cases injectss distinctsss =
   26.60 +fun mk_split_tac ctxt uexhaust cases injectss distinctsss =
   26.61    rtac uexhaust 1 THEN
   26.62    ALLGOALS (fn k => (hyp_subst_tac THEN'
   26.63       simp_tac (ss_only (@{thms simp_thms} @ cases @ nth injectss (k - 1) @
   26.64 -       flat (nth distinctsss (k - 1))))) k) THEN
   26.65 +       flat (nth distinctsss (k - 1))) ctxt)) k) THEN
   26.66    ALLGOALS (blast_tac naked_ctxt);
   26.67  
   26.68  val split_asm_thms = @{thms imp_conv_disj de_Morgan_conj de_Morgan_disj not_not not_ex};
    27.1 --- a/src/HOL/Bali/AxExample.thy	Tue Apr 16 17:54:14 2013 +0200
    27.2 +++ b/src/HOL/Bali/AxExample.thy	Thu Apr 18 17:07:01 2013 +0200
    27.3 @@ -126,7 +126,7 @@
    27.4  apply       (rule ax_subst_Var_allI)
    27.5  apply       (tactic {* inst1_tac @{context} "P'" "\<lambda>a vs l vf. ?PP a vs l vf\<leftarrow>?x \<and>. ?p" *})
    27.6  apply       (rule allI)
    27.7 -apply       (tactic {* simp_tac (@{simpset} delloop "split_all_tac" delsimps [@{thm peek_and_def2}, @{thm heap_def2}, @{thm subst_res_def2}, @{thm normal_def2}]) 1 *})
    27.8 +apply       (tactic {* simp_tac (@{context} delloop "split_all_tac" delsimps [@{thm peek_and_def2}, @{thm heap_def2}, @{thm subst_res_def2}, @{thm normal_def2}]) 1 *})
    27.9  apply       (rule ax_derivs.Abrupt)
   27.10  apply      (simp (no_asm))
   27.11  apply      (tactic "ax_tac 1" (* FVar *))
   27.12 @@ -176,26 +176,26 @@
   27.13  apply  (rule ax_InitS)
   27.14  apply     force
   27.15  apply    (simp (no_asm))
   27.16 -apply   (tactic {* simp_tac (@{simpset} delloop "split_all_tac") 1 *})
   27.17 +apply   (tactic {* simp_tac (@{context} delloop "split_all_tac") 1 *})
   27.18  apply   (rule ax_Init_Skip_lemma)
   27.19 -apply  (tactic {* simp_tac (@{simpset} delloop "split_all_tac") 1 *})
   27.20 +apply  (tactic {* simp_tac (@{context} delloop "split_all_tac") 1 *})
   27.21  apply  (rule ax_InitS [THEN conseq1] (* init Base *))
   27.22  apply      force
   27.23  apply     (simp (no_asm))
   27.24  apply    (unfold arr_viewed_from_def)
   27.25  apply    (rule allI)
   27.26  apply    (rule_tac P' = "Normal ?P" in conseq1)
   27.27 -apply     (tactic {* simp_tac (@{simpset} delloop "split_all_tac") 1 *})
   27.28 +apply     (tactic {* simp_tac (@{context} delloop "split_all_tac") 1 *})
   27.29  apply     (tactic "ax_tac 1")
   27.30  apply     (tactic "ax_tac 1")
   27.31  apply     (rule_tac [2] ax_subst_Var_allI)
   27.32  apply      (tactic {* inst1_tac @{context} "P'" "\<lambda>vf l vfa. Normal (?P vf l vfa)" *})
   27.33 -apply     (tactic {* simp_tac (@{simpset} delloop "split_all_tac" delsimps [@{thm split_paired_All}, @{thm peek_and_def2}, @{thm heap_free_def2}, @{thm initd_def2}, @{thm normal_def2}, @{thm supd_lupd}]) 2 *})
   27.34 +apply     (tactic {* simp_tac (@{context} delloop "split_all_tac" delsimps [@{thm split_paired_All}, @{thm peek_and_def2}, @{thm heap_free_def2}, @{thm initd_def2}, @{thm normal_def2}, @{thm supd_lupd}]) 2 *})
   27.35  apply      (tactic "ax_tac 2" (* NewA *))
   27.36  apply       (tactic "ax_tac 3" (* ax_Alloc_Arr *))
   27.37  apply       (tactic "ax_tac 3")
   27.38  apply      (tactic {* inst1_tac @{context} "P" "\<lambda>vf l vfa. Normal (?P vf l vfa\<leftarrow>\<diamondsuit>)" *})
   27.39 -apply      (tactic {* simp_tac (@{simpset} delloop "split_all_tac") 2 *})
   27.40 +apply      (tactic {* simp_tac (@{context} delloop "split_all_tac") 2 *})
   27.41  apply      (tactic "ax_tac 2")
   27.42  apply     (tactic "ax_tac 1" (* FVar *))
   27.43  apply      (tactic "ax_tac 2" (* StatRef *))
   27.44 @@ -206,7 +206,7 @@
   27.45  apply     (drule initedD)
   27.46  apply     (clarsimp elim!: atleast_free_SucD simp add: arr_inv_def)
   27.47  apply    force
   27.48 -apply   (tactic {* simp_tac (@{simpset} delloop "split_all_tac") 1 *})
   27.49 +apply   (tactic {* simp_tac (@{context} delloop "split_all_tac") 1 *})
   27.50  apply   (rule ax_triv_Init_Object [THEN peek_and_forget2, THEN conseq1])
   27.51  apply     (rule wf_tprg)
   27.52  apply    clarsimp
    28.1 --- a/src/HOL/Bali/AxSem.thy	Tue Apr 16 17:54:14 2013 +0200
    28.2 +++ b/src/HOL/Bali/AxSem.thy	Thu Apr 18 17:07:01 2013 +0200
    28.3 @@ -464,7 +464,7 @@
    28.4  declare split_paired_All [simp del] split_paired_Ex [simp del] 
    28.5  declare split_if     [split del] split_if_asm     [split del] 
    28.6          option.split [split del] option.split_asm [split del]
    28.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    28.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    28.9  setup {* map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac") *}
   28.10  
   28.11  inductive
    29.1 --- a/src/HOL/Bali/Basis.thy	Tue Apr 16 17:54:14 2013 +0200
    29.2 +++ b/src/HOL/Bali/Basis.thy	Thu Apr 18 17:07:01 2013 +0200
    29.3 @@ -12,7 +12,7 @@
    29.4  ML {* fun strip_tac i = REPEAT (resolve_tac [impI, allI] i) *}
    29.5  
    29.6  declare split_if_asm  [split] option.split [split] option.split_asm [split]
    29.7 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
    29.8 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
    29.9  declare if_weak_cong [cong del] option.weak_case_cong [cong del]
   29.10  declare length_Suc_conv [iff]
   29.11  
   29.12 @@ -180,7 +180,7 @@
   29.13  
   29.14  ML {*
   29.15  fun sum3_instantiate ctxt thm = map (fn s =>
   29.16 -  simplify (simpset_of ctxt delsimps [@{thm not_None_eq}])
   29.17 +  simplify (ctxt delsimps [@{thm not_None_eq}])
   29.18      (read_instantiate ctxt [(("t", 0), "In" ^ s ^ " ?x")] thm)) ["1l","2","3","1r"]
   29.19  *}
   29.20  (* e.g. lemmas is_stmt_rews = is_stmt_def [of "In1l x", simplified] *)
    30.1 --- a/src/HOL/Bali/DefiniteAssignment.thy	Tue Apr 16 17:54:14 2013 +0200
    30.2 +++ b/src/HOL/Bali/DefiniteAssignment.thy	Thu Apr 18 17:07:01 2013 +0200
    30.3 @@ -818,7 +818,7 @@
    30.4  declare inj_term_sym_simps [simp]
    30.5  declare assigns_if.simps [simp del]
    30.6  declare split_paired_All [simp del] split_paired_Ex [simp del]
    30.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    30.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    30.9  
   30.10  inductive_cases da_elim_cases [cases set]:
   30.11    "Env\<turnstile> B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> A" 
   30.12 @@ -884,7 +884,7 @@
   30.13  declare inj_term_sym_simps [simp del]
   30.14  declare assigns_if.simps [simp]
   30.15  declare split_paired_All [simp] split_paired_Ex [simp]
   30.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   30.17 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   30.18  
   30.19  (* To be able to eliminate both the versions with the overloaded brackets: 
   30.20     (B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> A) and with the explicit constructor (B \<guillemotright>In1r Skip\<guillemotright> A), 
    31.1 --- a/src/HOL/Bali/Eval.thy	Tue Apr 16 17:54:14 2013 +0200
    31.2 +++ b/src/HOL/Bali/Eval.thy	Thu Apr 18 17:07:01 2013 +0200
    31.3 @@ -780,7 +780,7 @@
    31.4  
    31.5  declare not_None_eq [simp del] (* IntDef.Zero_def [simp del] *)
    31.6  declare split_paired_All [simp del] split_paired_Ex [simp del]
    31.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    31.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    31.9  
   31.10  inductive_cases eval_cases: "G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (v, s')"
   31.11  
   31.12 @@ -818,7 +818,7 @@
   31.13          "G\<turnstile>Norm s \<midarrow>In1r (Init C)                       \<succ>\<rightarrow> (x, s')"
   31.14  declare not_None_eq [simp]  (* IntDef.Zero_def [simp] *)
   31.15  declare split_paired_All [simp] split_paired_Ex [simp]
   31.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   31.17 +declaration {* K (Simplifier.map_ss (fn ss => ss addloop' ("split_all_tac", split_all_tac))) *}
   31.18  declare split_if     [split] split_if_asm     [split] 
   31.19          option.split [split] option.split_asm [split]
   31.20  
    32.1 --- a/src/HOL/Bali/Evaln.thy	Tue Apr 16 17:54:14 2013 +0200
    32.2 +++ b/src/HOL/Bali/Evaln.thy	Thu Apr 18 17:07:01 2013 +0200
    32.3 @@ -197,7 +197,7 @@
    32.4          option.split [split del] option.split_asm [split del]
    32.5          not_None_eq [simp del] 
    32.6          split_paired_All [simp del] split_paired_Ex [simp del]
    32.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    32.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    32.9  
   32.10  inductive_cases evaln_cases: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s')"
   32.11  
   32.12 @@ -238,7 +238,7 @@
   32.13          option.split [split] option.split_asm [split]
   32.14          not_None_eq [simp] 
   32.15          split_paired_All [simp] split_paired_Ex [simp]
   32.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   32.17 +declaration {* K (Simplifier.map_ss (fn ss => ss addloop' ("split_all_tac", split_all_tac))) *}
   32.18  
   32.19  lemma evaln_Inj_elim: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (w,s') \<Longrightarrow> case t of In1 ec \<Rightarrow>  
   32.20    (case ec of Inl e \<Rightarrow> (\<exists>v. w = In1 v) | Inr c \<Rightarrow> w = \<diamondsuit>)  
    33.1 --- a/src/HOL/Bali/Example.thy	Tue Apr 16 17:54:14 2013 +0200
    33.2 +++ b/src/HOL/Bali/Example.thy	Thu Apr 18 17:07:01 2013 +0200
    33.3 @@ -1188,8 +1188,7 @@
    33.4          Base_foo_defs  [simp]
    33.5  
    33.6  ML {* bind_thms ("eval_intros", map 
    33.7 -        (simplify (@{simpset} delsimps @{thms Skip_eq}
    33.8 -                             addsimps @{thms lvar_def}) o 
    33.9 +        (simplify (@{context} delsimps @{thms Skip_eq} addsimps @{thms lvar_def}) o 
   33.10           rewrite_rule [@{thm assign_def}, @{thm Let_def}]) @{thms eval.intros}) *}
   33.11  lemmas eval_Is = eval_Init eval_StatRef AbruptIs eval_intros
   33.12  
    34.1 --- a/src/HOL/Bali/TypeSafe.thy	Tue Apr 16 17:54:14 2013 +0200
    34.2 +++ b/src/HOL/Bali/TypeSafe.thy	Thu Apr 18 17:07:01 2013 +0200
    34.3 @@ -726,7 +726,7 @@
    34.4  declare split_paired_All [simp del] split_paired_Ex [simp del] 
    34.5  declare split_if     [split del] split_if_asm     [split del] 
    34.6          option.split [split del] option.split_asm [split del]
    34.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    34.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    34.9  setup {* map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac") *}
   34.10  
   34.11  lemma FVar_lemma: 
   34.12 @@ -756,7 +756,7 @@
   34.13  declare split_if     [split] split_if_asm     [split] 
   34.14          option.split [split] option.split_asm [split]
   34.15  setup {* map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac)) *}
   34.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   34.17 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   34.18  
   34.19  
   34.20  lemma AVar_lemma1: "\<lbrakk>globs s (Inl a) = Some obj;tag obj=Arr ty i; 
   34.21 @@ -871,7 +871,7 @@
   34.22  declare split_paired_All [simp del] split_paired_Ex [simp del] 
   34.23  declare split_if     [split del] split_if_asm     [split del] 
   34.24          option.split [split del] option.split_asm [split del]
   34.25 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
   34.26 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
   34.27  setup {* map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac") *}
   34.28  
   34.29  lemma conforms_init_lvars: 
   34.30 @@ -925,7 +925,7 @@
   34.31  declare split_if     [split] split_if_asm     [split] 
   34.32          option.split [split] option.split_asm [split]
   34.33  setup {* map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac)) *}
   34.34 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   34.35 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   34.36  
   34.37  
   34.38  subsection "accessibility"
    35.1 --- a/src/HOL/Bali/WellForm.thy	Tue Apr 16 17:54:14 2013 +0200
    35.2 +++ b/src/HOL/Bali/WellForm.thy	Thu Apr 18 17:07:01 2013 +0200
    35.3 @@ -2127,7 +2127,7 @@
    35.4  qed
    35.5  
    35.6  declare split_paired_All [simp del] split_paired_Ex [simp del]
    35.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    35.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    35.9  setup {* map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac") *}
   35.10  
   35.11  lemma dynamic_mheadsD:   
   35.12 @@ -2258,7 +2258,7 @@
   35.13  qed
   35.14  declare split_paired_All [simp] split_paired_Ex [simp]
   35.15  setup {* map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac)) *}
   35.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   35.17 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   35.18  
   35.19  (* Tactical version *)
   35.20  (*
   35.21 @@ -2401,7 +2401,7 @@
   35.22    
   35.23  
   35.24  declare split_paired_All [simp del] split_paired_Ex [simp del]
   35.25 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
   35.26 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
   35.27  setup {* map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac") *}
   35.28  
   35.29  lemma wt_is_type: "E,dt\<Turnstile>v\<Colon>T \<Longrightarrow>  wf_prog (prg E) \<longrightarrow> 
   35.30 @@ -2427,7 +2427,7 @@
   35.31  done
   35.32  declare split_paired_All [simp] split_paired_Ex [simp]
   35.33  setup {* map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac)) *}
   35.34 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   35.35 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   35.36  
   35.37  lemma ty_expr_is_type: 
   35.38  "\<lbrakk>E\<turnstile>e\<Colon>-T; wf_prog (prg E)\<rbrakk> \<Longrightarrow> is_type (prg E) T"
    36.1 --- a/src/HOL/Bali/WellType.thy	Tue Apr 16 17:54:14 2013 +0200
    36.2 +++ b/src/HOL/Bali/WellType.thy	Thu Apr 18 17:07:01 2013 +0200
    36.3 @@ -458,7 +458,7 @@
    36.4  declare not_None_eq [simp del] 
    36.5  declare split_if [split del] split_if_asm [split del]
    36.6  declare split_paired_All [simp del] split_paired_Ex [simp del]
    36.7 -declaration {* K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac")) *}
    36.8 +setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}
    36.9  
   36.10  inductive_cases wt_elim_cases [cases set]:
   36.11          "E,dt\<Turnstile>In2  (LVar vn)               \<Colon>T"
   36.12 @@ -494,7 +494,7 @@
   36.13  declare not_None_eq [simp] 
   36.14  declare split_if [split] split_if_asm [split]
   36.15  declare split_paired_All [simp] split_paired_Ex [simp]
   36.16 -declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}
   36.17 +setup {* map_theory_simpset (fn ctxt => ctxt addloop' ("split_all_tac", split_all_tac)) *}
   36.18  
   36.19  lemma is_acc_class_is_accessible: 
   36.20    "is_acc_class G P C \<Longrightarrow> G\<turnstile>(Class C) accessible_in P"
    37.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Tue Apr 16 17:54:14 2013 +0200
    37.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Thu Apr 18 17:07:01 2013 +0200
    37.3 @@ -3487,7 +3487,7 @@
    37.4                                       (@{cpat "?prec::nat"}, p),
    37.5                                       (@{cpat "?ss::nat list"}, s)])
    37.6                @{thm "approx_form"}) i
    37.7 -          THEN simp_tac @{simpset} i) st
    37.8 +          THEN simp_tac @{context} i) st
    37.9         end
   37.10  
   37.11       | SOME t => if length vs <> 1 then raise (TERM ("More than one variable used for taylor series expansion", [prop_of st]))
    38.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Tue Apr 16 17:54:14 2013 +0200
    38.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Thu Apr 18 17:07:01 2013 +0200
    38.3 @@ -579,7 +579,8 @@
    38.4                   else Ferrante_Rackoff_Data.Nox
    38.5         | _ => Ferrante_Rackoff_Data.Nox
    38.6    in h end
    38.7 -  fun ss phi = HOL_ss addsimps (simps phi)
    38.8 +  fun ss phi =
    38.9 +    simpset_of (put_simpset HOL_ss @{context} addsimps (simps phi))
   38.10  in
   38.11    Ferrante_Rackoff_Data.funs  @{thm "ferrack_axiom"}
   38.12      {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss}
   38.13 @@ -749,7 +750,7 @@
   38.14          val clt = Thm.dest_fun2 ct
   38.15          val cz = Thm.dest_arg ct
   38.16          val neg = cr </ Rat.zero
   38.17 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.18 +        val cthp = Simplifier.rewrite ctxt
   38.19                 (Thm.apply @{cterm "Trueprop"}
   38.20                    (if neg then Thm.apply (Thm.apply clt c) cz
   38.21                      else Thm.apply (Thm.apply clt cz) c))
   38.22 @@ -772,7 +773,7 @@
   38.23          val clt = Thm.dest_fun2 ct
   38.24          val cz = Thm.dest_arg ct
   38.25          val neg = cr </ Rat.zero
   38.26 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.27 +        val cthp = Simplifier.rewrite ctxt
   38.28                 (Thm.apply @{cterm "Trueprop"}
   38.29                    (if neg then Thm.apply (Thm.apply clt c) cz
   38.30                      else Thm.apply (Thm.apply clt cz) c))
   38.31 @@ -793,7 +794,7 @@
   38.32          val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
   38.33          val cz = Thm.dest_arg ct
   38.34          val neg = cr </ Rat.zero
   38.35 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.36 +        val cthp = Simplifier.rewrite ctxt
   38.37                 (Thm.apply @{cterm "Trueprop"}
   38.38                    (if neg then Thm.apply (Thm.apply clt c) cz
   38.39                      else Thm.apply (Thm.apply clt cz) c))
   38.40 @@ -817,7 +818,7 @@
   38.41          val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
   38.42          val cz = Thm.dest_arg ct
   38.43          val neg = cr </ Rat.zero
   38.44 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.45 +        val cthp = Simplifier.rewrite ctxt
   38.46                 (Thm.apply @{cterm "Trueprop"}
   38.47                    (if neg then Thm.apply (Thm.apply clt c) cz
   38.48                      else Thm.apply (Thm.apply clt cz) c))
   38.49 @@ -836,7 +837,7 @@
   38.50          val cr = dest_frac c
   38.51          val ceq = Thm.dest_fun2 ct
   38.52          val cz = Thm.dest_arg ct
   38.53 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.54 +        val cthp = Simplifier.rewrite ctxt
   38.55              (Thm.apply @{cterm "Trueprop"}
   38.56               (Thm.apply @{cterm "Not"} (Thm.apply (Thm.apply ceq c) cz)))
   38.57          val cth = Thm.equal_elim (Thm.symmetric cthp) TrueI
   38.58 @@ -858,7 +859,7 @@
   38.59          val cr = dest_frac c
   38.60          val ceq = Thm.dest_fun2 ct
   38.61          val cz = Thm.dest_arg ct
   38.62 -        val cthp = Simplifier.rewrite (simpset_of ctxt)
   38.63 +        val cthp = Simplifier.rewrite ctxt
   38.64              (Thm.apply @{cterm "Trueprop"}
   38.65               (Thm.apply @{cterm "Not"} (Thm.apply (Thm.apply ceq c) cz)))
   38.66          val cth = Thm.equal_elim (Thm.symmetric cthp) TrueI
   38.67 @@ -924,8 +925,9 @@
   38.68     | _ => Ferrante_Rackoff_Data.Nox
   38.69   in h end;
   38.70  fun class_field_ss phi =
   38.71 -   HOL_basic_ss addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
   38.72 -   |> fold Splitter.add_split [@{thm "abs_split"}, @{thm "split_max"}, @{thm "split_min"}]
   38.73 +  simpset_of (put_simpset HOL_basic_ss @{context}
   38.74 +    addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
   38.75 +    |> fold Splitter.add_split [@{thm "abs_split"}, @{thm "split_max"}, @{thm "split_min"}])
   38.76  
   38.77  in
   38.78  Ferrante_Rackoff_Data.funs @{thm "class_dense_linordered_field.ferrack_axiom"}
    39.1 --- a/src/HOL/Decision_Procs/commutative_ring_tac.ML	Tue Apr 16 17:54:14 2013 +0200
    39.2 +++ b/src/HOL/Decision_Procs/commutative_ring_tac.ML	Thu Apr 18 17:07:01 2013 +0200
    39.3 @@ -86,15 +86,14 @@
    39.4  fun tac ctxt = SUBGOAL (fn (g, i) =>
    39.5    let
    39.6      val thy = Proof_Context.theory_of ctxt;
    39.7 -    val cring_ss = Simplifier.simpset_of ctxt  (*FIXME really the full simpset!?*)
    39.8 -      addsimps cring_simps;
    39.9 +    val cring_ctxt = ctxt addsimps cring_simps;  (*FIXME really the full simpset!?*)
   39.10      val (ca, cvs, clhs, crhs) = reif_eq thy (HOLogic.dest_Trueprop g)
   39.11      val norm_eq_th =
   39.12 -      simplify cring_ss (instantiate' [SOME ca] [SOME clhs, SOME crhs, SOME cvs] @{thm norm_eq})
   39.13 +      simplify cring_ctxt (instantiate' [SOME ca] [SOME clhs, SOME crhs, SOME cvs] @{thm norm_eq})
   39.14    in
   39.15      cut_tac norm_eq_th i
   39.16 -    THEN (simp_tac cring_ss i)
   39.17 -    THEN (simp_tac cring_ss i)
   39.18 +    THEN (simp_tac cring_ctxt i)
   39.19 +    THEN (simp_tac cring_ctxt i)
   39.20    end);
   39.21  
   39.22  end;
    40.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Tue Apr 16 17:54:14 2013 +0200
    40.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Thu Apr 18 17:07:01 2013 +0200
    40.3 @@ -14,7 +14,7 @@
    40.4  val trace = Unsynchronized.ref false;
    40.5  fun trace_msg s = if !trace then tracing s else ();
    40.6  
    40.7 -val cooper_ss = @{simpset};
    40.8 +val cooper_ss = simpset_of @{context};
    40.9  
   40.10  val nT = HOLogic.natT;
   40.11  val comp_arith = @{thms simp_thms}
   40.12 @@ -68,7 +68,8 @@
   40.13      (* Transform the term*)
   40.14      val (t,np,nh) = prepare_for_linz q g
   40.15      (* Some simpsets for dealing with mod div abs and nat*)
   40.16 -    val mod_div_simpset = HOL_basic_ss
   40.17 +    val mod_div_simpset =
   40.18 +      put_simpset HOL_basic_ss ctxt
   40.19        addsimps [refl,mod_add_eq, mod_add_left_eq,
   40.20            mod_add_right_eq,
   40.21            nat_div_add_eq, int_div_add_eq,
   40.22 @@ -78,29 +79,32 @@
   40.23            Suc_eq_plus1]
   40.24        addsimps @{thms add_ac}
   40.25        addsimprocs [@{simproc cancel_div_mod_nat}, @{simproc cancel_div_mod_int}]
   40.26 -    val simpset0 = HOL_basic_ss
   40.27 +    val simpset0 =
   40.28 +      put_simpset HOL_basic_ss ctxt
   40.29        addsimps [mod_div_equality', Suc_eq_plus1]
   40.30        addsimps comp_arith
   40.31        |> fold Splitter.add_split
   40.32            [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
   40.33      (* Simp rules for changing (n::int) to int n *)
   40.34 -    val simpset1 = HOL_basic_ss
   40.35 +    val simpset1 =
   40.36 +      put_simpset HOL_basic_ss ctxt
   40.37        addsimps [zdvd_int] @ map (fn r => r RS sym)
   40.38          [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   40.39        |> Splitter.add_split zdiff_int_split
   40.40      (*simp rules for elimination of int n*)
   40.41  
   40.42 -    val simpset2 = HOL_basic_ss
   40.43 +    val simpset2 =
   40.44 +      put_simpset HOL_basic_ss ctxt
   40.45        addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat}, @{thm zero_le_numeral}, @{thm order_refl}(* FIXME: necessary? *), @{thm int_0}, @{thm int_1}]
   40.46        |> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
   40.47      (* simp rules for elimination of abs *)
   40.48 -    val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
   40.49 +    val simpset3 = put_simpset HOL_basic_ss ctxt |> Splitter.add_split @{thm abs_split}
   40.50      val ct = cterm_of thy (HOLogic.mk_Trueprop t)
   40.51      (* Theorem for the nat --> int transformation *)
   40.52      val pre_thm = Seq.hd (EVERY
   40.53        [simp_tac mod_div_simpset 1, simp_tac simpset0 1,
   40.54         TRY (simp_tac simpset1 1), TRY (simp_tac simpset2 1),
   40.55 -       TRY (simp_tac simpset3 1), TRY (simp_tac cooper_ss 1)]
   40.56 +       TRY (simp_tac simpset3 1), TRY (simp_tac (put_simpset cooper_ss ctxt) 1)]
   40.57        (Thm.trivial ct))
   40.58      fun assm_tac i = REPEAT_DETERM_N nh (assume_tac i)
   40.59      (* The result of the quantifier elimination *)
    41.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Tue Apr 16 17:54:14 2013 +0200
    41.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Thu Apr 18 17:07:01 2013 +0200
    41.3 @@ -16,8 +16,8 @@
    41.4  
    41.5  val ferrack_ss = let val ths = [@{thm real_of_int_inject}, @{thm real_of_int_less_iff}, 
    41.6                                  @{thm real_of_int_le_iff}]
    41.7 -             in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
    41.8 -             end;
    41.9 +             in @{context} delsimps ths addsimps (map (fn th => th RS sym) ths)
   41.10 +             end |> simpset_of;
   41.11  
   41.12  val binarith = @{thms arith_simps}
   41.13  val comp_arith = binarith @ @{thms simp_thms}
   41.14 @@ -74,12 +74,12 @@
   41.15      (* Transform the term*)
   41.16      val (t,np,nh) = prepare_for_linr thy q g
   41.17      (* Some simpsets for dealing with mod div abs and nat*)
   41.18 -    val simpset0 = Simplifier.context ctxt HOL_basic_ss addsimps comp_arith
   41.19 +    val simpset0 = put_simpset HOL_basic_ss ctxt addsimps comp_arith
   41.20      val ct = cterm_of thy (HOLogic.mk_Trueprop t)
   41.21      (* Theorem for the nat --> int transformation *)
   41.22     val pre_thm = Seq.hd (EVERY
   41.23        [simp_tac simpset0 1,
   41.24 -       TRY (simp_tac (Simplifier.context ctxt ferrack_ss) 1)]
   41.25 +       TRY (simp_tac (put_simpset ferrack_ss ctxt) 1)]
   41.26        (Thm.trivial ct))
   41.27      fun assm_tac i = REPEAT_DETERM_N nh (assume_tac i)
   41.28      (* The result of the quantifier elimination *)
    42.1 --- a/src/HOL/Decision_Procs/ferrante_rackoff.ML	Tue Apr 16 17:54:14 2013 +0200
    42.2 +++ b/src/HOL/Decision_Procs/ferrante_rackoff.ML	Thu Apr 18 17:07:01 2013 +0200
    42.3 @@ -27,7 +27,7 @@
    42.4    funpow 2 (Thm.dest_arg o snd o Thm.dest_abs NONE)
    42.5      (funpow 2 Thm.dest_arg (cprop_of th)) |> Thm.dest_arg
    42.6  
    42.7 -fun ferrack_conv
    42.8 +fun ferrack_conv ctxt
    42.9     (entr as ({minf = minf, pinf = pinf, nmi = nmi, npi = npi,
   42.10                ld = ld, qe = qe, atoms = atoms},
   42.11               {isolate_conv = icv, whatis = wi, simpset = simpset}):entry) =
   42.12 @@ -163,7 +163,7 @@
   42.13                          qe))
   42.14                    [fU, ld_th, nmi_th, npi_th, minf_th, pinf_th]
   42.15      val bex_conv =
   42.16 -      Simplifier.rewrite (HOL_basic_ss addsimps @{thms simp_thms bex_simps(1-5)})
   42.17 +      Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms bex_simps(1-5)})
   42.18      val result_th = fconv_rule (arg_conv bex_conv) (Thm.transitive enth qe_th)
   42.19     in result_th
   42.20     end
   42.21 @@ -196,22 +196,21 @@
   42.22     in h (bounds + 1) b' end;
   42.23  in h end;
   42.24  
   42.25 -fun raw_ferrack_qe_conv ctxt (thy, {isolate_conv, whatis, simpset}) tm =
   42.26 +fun raw_ferrack_qe_conv ctxt (thy, {isolate_conv, whatis, simpset = ss}) tm =
   42.27   let
   42.28 -   val ss = simpset
   42.29     val ss' =
   42.30 -     merge_ss (HOL_basic_ss addsimps @{thms simp_thms ex_simps all_simps
   42.31 -                not_all all_not_ex ex_disj_distrib}, ss)
   42.32 -     |> Simplifier.inherit_context ss
   42.33 -   val pcv = Simplifier.rewrite ss'     
   42.34 -   val postcv = Simplifier.rewrite ss
   42.35 -   val nnf = K (nnf_conv then_conv postcv)
   42.36 +     merge_ss (simpset_of
   42.37 +      (put_simpset HOL_basic_ss ctxt addsimps
   42.38 +        @{thms simp_thms ex_simps all_simps not_all all_not_ex ex_disj_distrib}), ss);
   42.39 +   val pcv = Simplifier.rewrite (put_simpset ss' ctxt);
   42.40 +   val postcv = Simplifier.rewrite (put_simpset ss ctxt);
   42.41 +   val nnf = K (nnf_conv ctxt then_conv postcv)
   42.42     val qe_conv = Qelim.gen_qelim_conv pcv postcv pcv cons (Thm.add_cterm_frees tm [])
   42.43                    (isolate_conv ctxt) nnf
   42.44 -                  (fn vs => ferrack_conv (thy,{isolate_conv = isolate_conv ctxt,
   42.45 -                                               whatis = whatis, simpset = simpset}) vs
   42.46 +                  (fn vs => ferrack_conv ctxt (thy,{isolate_conv = isolate_conv ctxt,
   42.47 +                                               whatis = whatis, simpset = ss}) vs
   42.48                     then_conv postcv)
   42.49 - in (Simplifier.rewrite ss then_conv qe_conv) tm end;
   42.50 + in (Simplifier.rewrite (put_simpset ss ctxt) then_conv qe_conv) tm end;
   42.51  
   42.52  fun dlo_instance ctxt tm =
   42.53    Ferrante_Rackoff_Data.match ctxt (grab_atom_bop 0 tm);
   42.54 @@ -226,8 +225,8 @@
   42.55      NONE => no_tac
   42.56    | SOME instance =>
   42.57        Object_Logic.full_atomize_tac i THEN
   42.58 -      simp_tac (#simpset (snd instance)) i THEN  (* FIXME already part of raw_ferrack_qe_conv? *)
   42.59 +      simp_tac (put_simpset (#simpset (snd instance)) ctxt) i THEN  (* FIXME already part of raw_ferrack_qe_conv? *)
   42.60        CONVERSION (Object_Logic.judgment_conv (raw_ferrack_qe_conv ctxt instance)) i THEN
   42.61 -      simp_tac (simpset_of ctxt) i));  (* FIXME really? *)
   42.62 +      simp_tac ctxt i));  (* FIXME really? *)
   42.63  
   42.64  end;
    43.1 --- a/src/HOL/Decision_Procs/langford.ML	Tue Apr 16 17:54:14 2013 +0200
    43.2 +++ b/src/HOL/Decision_Procs/langford.ML	Thu Apr 18 17:07:01 2013 +0200
    43.3 @@ -26,16 +26,18 @@
    43.4                                       (Thm.cprop_of th), SOME x] th1) th
    43.5  in fold ins u th0 end;
    43.6  
    43.7 -val simp_rule =
    43.8 +fun simp_rule ctxt =
    43.9    Conv.fconv_rule
   43.10 -    (Conv.arg_conv (Simplifier.rewrite (HOL_basic_ss addsimps @{thms ball_simps simp_thms})));
   43.11 +    (Conv.arg_conv
   43.12 +      (Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms ball_simps simp_thms})));
   43.13  
   43.14  fun basic_dloqe ctxt stupid dlo_qeth dlo_qeth_nolb dlo_qeth_noub gather ep = 
   43.15   case term_of ep of 
   43.16    Const(@{const_name Ex},_)$_ => 
   43.17     let 
   43.18       val p = Thm.dest_arg ep
   43.19 -     val ths = simplify (HOL_basic_ss addsimps gather) (instantiate' [] [SOME p] stupid)
   43.20 +     val ths =
   43.21 +      simplify (put_simpset HOL_basic_ss ctxt addsimps gather) (instantiate' [] [SOME p] stupid)
   43.22       val (L,U) = 
   43.23         let 
   43.24           val (x,q) = Thm.dest_abs NONE (Thm.dest_arg (Thm.rhs_of ths))
   43.25 @@ -53,17 +55,17 @@
   43.26        (Const (@{const_name Orderings.bot}, _),_) =>  
   43.27          let
   43.28            val (neU,fU) = proveneF U 
   43.29 -        in simp_rule (Thm.transitive ths (dlo_qeth_nolb OF [neU, fU])) end
   43.30 +        in simp_rule ctxt (Thm.transitive ths (dlo_qeth_nolb OF [neU, fU])) end
   43.31      | (_,Const (@{const_name Orderings.bot}, _)) =>  
   43.32          let
   43.33            val (neL,fL) = proveneF L
   43.34 -        in simp_rule (Thm.transitive ths (dlo_qeth_noub OF [neL, fL])) end
   43.35 +        in simp_rule ctxt (Thm.transitive ths (dlo_qeth_noub OF [neL, fL])) end
   43.36  
   43.37      | (_,_) =>  
   43.38        let 
   43.39         val (neL,fL) = proveneF L
   43.40         val (neU,fU) = proveneF U
   43.41 -      in simp_rule (Thm.transitive ths (dlo_qeth OF [neL, neU, fL, fU])) 
   43.42 +      in simp_rule ctxt (Thm.transitive ths (dlo_qeth OF [neL, neU, fL, fU])) 
   43.43        end
   43.44     in qe end 
   43.45   | _ => error "dlo_qe : Not an existential formula";
   43.46 @@ -122,7 +124,7 @@
   43.47   | _ => false ;
   43.48  
   43.49  local 
   43.50 -fun proc ct = 
   43.51 +fun proc ctxt ct = 
   43.52   case term_of ct of
   43.53    Const(@{const_name Ex},_)$Abs (xn,_,_) => 
   43.54     let 
   43.55 @@ -140,35 +142,36 @@
   43.56                   (Thm.apply @{cterm Trueprop} (list_conj (ndx @dx))))
   43.57             |> Thm.abstract_rule xn x |> Drule.arg_cong_rule e 
   43.58             |> Conv.fconv_rule (Conv.arg_conv 
   43.59 -                   (Simplifier.rewrite (HOL_basic_ss addsimps @{thms simp_thms ex_simps})))
   43.60 +               (Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms ex_simps})))
   43.61             |> SOME
   43.62            end
   43.63      | _ => conj_aci_rule (Thm.mk_binop @{cterm "op == :: prop => _"} Pp 
   43.64                   (Thm.apply @{cterm Trueprop} (list_conj (eqs@neqs))))
   43.65             |> Thm.abstract_rule xn x |> Drule.arg_cong_rule e 
   43.66             |> Conv.fconv_rule (Conv.arg_conv 
   43.67 -                   (Simplifier.rewrite (HOL_basic_ss addsimps @{thms simp_thms ex_simps})))
   43.68 +               (Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms ex_simps})))
   43.69             |> SOME
   43.70     end
   43.71   | _ => NONE;
   43.72  in val reduce_ex_simproc = 
   43.73    Simplifier.make_simproc 
   43.74    {lhss = [@{cpat "EX x. ?P x"}] , name = "reduce_ex_simproc",
   43.75 -   proc = K (K proc) , identifier = []}
   43.76 +   proc = K proc, identifier = []}
   43.77  end;
   43.78  
   43.79 -fun raw_dlo_conv dlo_ss 
   43.80 +fun raw_dlo_conv ctxt dlo_ss 
   43.81            ({qe_bnds, qe_nolb, qe_noub, gst, gs, atoms}:Langford_Data.entry) = 
   43.82   let 
   43.83 -  val ss = dlo_ss addsimps @{thms "dnf_simps"} addsimprocs [reduce_ex_simproc]
   43.84 -  val dnfex_conv = Simplifier.rewrite ss
   43.85 +  val ctxt' = put_simpset dlo_ss ctxt addsimps @{thms "dnf_simps"} addsimprocs [reduce_ex_simproc]
   43.86 +  val dnfex_conv = Simplifier.rewrite ctxt'
   43.87    val pcv =
   43.88      Simplifier.rewrite
   43.89 -      (dlo_ss addsimps @{thms simp_thms ex_simps all_simps all_not_ex not_all ex_disj_distrib})
   43.90 +      (put_simpset dlo_ss ctxt
   43.91 +        addsimps @{thms simp_thms ex_simps all_simps all_not_ex not_all ex_disj_distrib})
   43.92   in fn p => 
   43.93     Qelim.gen_qelim_conv pcv pcv dnfex_conv cons 
   43.94                    (Thm.add_cterm_frees p [])  (K Thm.reflexive) (K Thm.reflexive)
   43.95 -                  (K (basic_dloqe () gst qe_bnds qe_nolb qe_noub gs)) p
   43.96 +                  (K (basic_dloqe ctxt gst qe_bnds qe_nolb qe_noub gs)) p
   43.97   end;
   43.98  
   43.99  
  43.100 @@ -204,7 +207,7 @@
  43.101  fun dlo_conv ctxt tm =
  43.102    (case dlo_instance ctxt tm of
  43.103      (_, NONE) => raise CTERM ("dlo_conv (langford): no corresponding instance in context!", [tm])
  43.104 -  | (ss, SOME instance) => raw_dlo_conv ss instance tm);
  43.105 +  | (ss, SOME instance) => raw_dlo_conv ctxt ss instance tm);
  43.106  
  43.107  fun generalize_tac f = CSUBGOAL (fn (p, i) => PRIMITIVE (fn st =>
  43.108   let 
  43.109 @@ -232,13 +235,13 @@
  43.110  
  43.111  fun dlo_tac ctxt = CSUBGOAL (fn (p, i) =>
  43.112    (case dlo_instance ctxt p of
  43.113 -    (ss, NONE) => simp_tac ss i
  43.114 -  | (ss,  SOME instance) =>
  43.115 +    (ss, NONE) => simp_tac (put_simpset ss ctxt) i
  43.116 +  | (ss, SOME instance) =>
  43.117        Object_Logic.full_atomize_tac i THEN
  43.118 -      simp_tac ss i
  43.119 +      simp_tac (put_simpset ss ctxt) i
  43.120        THEN (CONVERSION Thm.eta_long_conversion) i
  43.121        THEN (TRY o generalize_tac (cfrees (#atoms instance))) i
  43.122        THEN Object_Logic.full_atomize_tac i
  43.123 -      THEN CONVERSION (Object_Logic.judgment_conv (raw_dlo_conv ss instance)) i
  43.124 -      THEN (simp_tac ss i)));  
  43.125 +      THEN CONVERSION (Object_Logic.judgment_conv (raw_dlo_conv ctxt ss instance)) i
  43.126 +      THEN (simp_tac (put_simpset ss ctxt) i)));
  43.127  end;
  43.128 \ No newline at end of file
    44.1 --- a/src/HOL/Decision_Procs/langford_data.ML	Tue Apr 16 17:54:14 2013 +0200
    44.2 +++ b/src/HOL/Decision_Procs/langford_data.ML	Thu Apr 18 17:07:01 2013 +0200
    44.3 @@ -36,9 +36,11 @@
    44.4      Thm.declaration_attribute (fn key => fn context => context |> Data.map 
    44.5        (del_data key #> apsnd (cons (key, entry))));
    44.6  
    44.7 -val add_simp = Thm.declaration_attribute (Data.map o apfst o Simplifier.add_simp);
    44.8 +val add_simp = Thm.declaration_attribute (fn th => fn context =>
    44.9 +  (Data.map o apfst) (simpset_map (Context.proof_of context) (Simplifier.add_simp th)) context);
   44.10  
   44.11 -val del_simp = Thm.declaration_attribute (Data.map o apfst o Simplifier.del_simp);
   44.12 +val del_simp = Thm.declaration_attribute (fn th => fn context =>
   44.13 +  (Data.map o apfst) (simpset_map (Context.proof_of context) (Simplifier.del_simp th)) context);
   44.14  
   44.15  fun match ctxt tm =
   44.16    let
    45.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Tue Apr 16 17:54:14 2013 +0200
    45.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Thu Apr 18 17:07:01 2013 +0200
    45.3 @@ -16,7 +16,7 @@
    45.4  
    45.5  val mir_ss = 
    45.6  let val ths = [@{thm "real_of_int_inject"}, @{thm "real_of_int_less_iff"}, @{thm "real_of_int_le_iff"}]
    45.7 -in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
    45.8 +in simpset_of (@{context} delsimps ths addsimps (map (fn th => th RS sym) ths))
    45.9  end;
   45.10  
   45.11  val nT = HOLogic.natT;
   45.12 @@ -83,7 +83,8 @@
   45.13  
   45.14  fun mir_tac ctxt q = 
   45.15      Object_Logic.atomize_prems_tac
   45.16 -        THEN' simp_tac (HOL_basic_ss addsimps [@{thm "abs_ge_zero"}] addsimps @{thms simp_thms})
   45.17 +        THEN' simp_tac (put_simpset HOL_basic_ss ctxt
   45.18 +          addsimps [@{thm "abs_ge_zero"}] addsimps @{thms simp_thms})
   45.19          THEN' (REPEAT_DETERM o split_tac [@{thm "split_min"}, @{thm "split_max"}, @{thm "abs_split"}])
   45.20          THEN' SUBGOAL (fn (g, i) =>
   45.21    let
   45.22 @@ -91,7 +92,7 @@
   45.23      (* Transform the term*)
   45.24      val (t,np,nh) = prepare_for_mir q g
   45.25      (* Some simpsets for dealing with mod div abs and nat*)
   45.26 -    val mod_div_simpset = HOL_basic_ss 
   45.27 +    val mod_div_simpset = put_simpset HOL_basic_ss ctxt
   45.28                          addsimps [refl, mod_add_eq, 
   45.29                                    @{thm mod_self},
   45.30                                    @{thm div_0}, @{thm mod_0},
   45.31 @@ -99,21 +100,21 @@
   45.32                                    @{thm "Suc_eq_plus1"}]
   45.33                          addsimps @{thms add_ac}
   45.34                          addsimprocs [@{simproc cancel_div_mod_nat}, @{simproc cancel_div_mod_int}]
   45.35 -    val simpset0 = HOL_basic_ss
   45.36 +    val simpset0 = put_simpset HOL_basic_ss ctxt
   45.37        addsimps [mod_div_equality', @{thm Suc_eq_plus1}]
   45.38        addsimps comp_ths
   45.39        |> fold Splitter.add_split
   45.40            [@{thm "split_zdiv"}, @{thm "split_zmod"}, @{thm "split_div'"},
   45.41              @{thm "split_min"}, @{thm "split_max"}]
   45.42      (* Simp rules for changing (n::int) to int n *)
   45.43 -    val simpset1 = HOL_basic_ss
   45.44 +    val simpset1 = put_simpset HOL_basic_ss ctxt
   45.45        addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
   45.46          [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"}, 
   45.47           @{thm nat_numeral}, @{thm "zmult_int"}]
   45.48        |> Splitter.add_split @{thm "zdiff_int_split"}
   45.49      (*simp rules for elimination of int n*)
   45.50  
   45.51 -    val simpset2 = HOL_basic_ss
   45.52 +    val simpset2 = put_simpset HOL_basic_ss ctxt
   45.53        addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral}, 
   45.54                  @{thm "int_0"}, @{thm "int_1"}]
   45.55        |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
   45.56 @@ -122,7 +123,8 @@
   45.57      (* Theorem for the nat --> int transformation *)
   45.58      val pre_thm = Seq.hd (EVERY
   45.59        [simp_tac mod_div_simpset 1, simp_tac simpset0 1,
   45.60 -       TRY (simp_tac simpset1 1), TRY (simp_tac simpset2 1), TRY (simp_tac mir_ss 1)]
   45.61 +       TRY (simp_tac simpset1 1), TRY (simp_tac simpset2 1),
   45.62 +       TRY (simp_tac (put_simpset mir_ss ctxt) 1)]
   45.63        (Thm.trivial ct))
   45.64      fun assm_tac i = REPEAT_DETERM_N nh (assume_tac i)
   45.65      (* The result of the quantifier elimination *)
    46.1 --- a/src/HOL/Divides.thy	Tue Apr 16 17:54:14 2013 +0200
    46.2 +++ b/src/HOL/Divides.thy	Thu Apr 18 17:07:01 2013 +0200
    46.3 @@ -1643,12 +1643,12 @@
    46.4    val simps = @{thms arith_simps} @ @{thms rel_simps} @
    46.5      map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
    46.6    fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
    46.7 -    (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
    46.8 -  fun binary_proc proc ss ct =
    46.9 +    (K (ALLGOALS (full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simps))));
   46.10 +  fun binary_proc proc ctxt ct =
   46.11      (case Thm.term_of ct of
   46.12        _ $ t $ u =>
   46.13        (case try (pairself (`(snd o HOLogic.dest_number))) (t, u) of
   46.14 -        SOME args => proc (Simplifier.the_context ss) args
   46.15 +        SOME args => proc ctxt args
   46.16        | NONE => NONE)
   46.17      | _ => NONE);
   46.18  in
    47.1 --- a/src/HOL/Fun.thy	Tue Apr 16 17:54:14 2013 +0200
    47.2 +++ b/src/HOL/Fun.thy	Thu Apr 18 17:07:01 2013 +0200
    47.3 @@ -795,9 +795,10 @@
    47.4          | find t = NONE
    47.5      in (dest_fun_T1 T, gen_fun_upd (find f) T x y) end
    47.6  
    47.7 -  fun proc ss ct =
    47.8 +  val ss = simpset_of @{context}
    47.9 +
   47.10 +  fun proc ctxt ct =
   47.11      let
   47.12 -      val ctxt = Simplifier.the_context ss
   47.13        val t = Thm.term_of ct
   47.14      in
   47.15        case find_double t of
   47.16 @@ -807,7 +808,7 @@
   47.17              (fn _ =>
   47.18                rtac eq_reflection 1 THEN
   47.19                rtac ext 1 THEN
   47.20 -              simp_tac (Simplifier.inherit_context ss @{simpset}) 1))
   47.21 +              simp_tac (put_simpset ss ctxt) 1))
   47.22      end
   47.23  in proc end
   47.24  *}
    48.1 --- a/src/HOL/HOL.thy	Tue Apr 16 17:54:14 2013 +0200
    48.2 +++ b/src/HOL/HOL.thy	Thu Apr 18 17:07:01 2013 +0200
    48.3 @@ -1189,7 +1189,7 @@
    48.4  ML_file "Tools/simpdata.ML"
    48.5  ML {* open Simpdata *}
    48.6  
    48.7 -setup {* Simplifier.map_simpset_global (K HOL_basic_ss) *}
    48.8 +setup {* map_theory_simpset (put_simpset HOL_basic_ss) *}
    48.9  
   48.10  simproc_setup defined_Ex ("EX x. P x") = {* fn _ => Quantifier1.rearrange_ex *}
   48.11  simproc_setup defined_All ("ALL x. P x") = {* fn _ => Quantifier1.rearrange_all *}
   48.12 @@ -1241,10 +1241,9 @@
   48.13     case t
   48.14      of Abs (_, _, t') => count_loose t' 0 <= 1
   48.15       | _ => true;
   48.16 -in fn _ => fn ss => fn ct => if is_trivial_let (Thm.term_of ct)
   48.17 +in fn _ => fn ctxt => fn ct => if is_trivial_let (Thm.term_of ct)
   48.18    then SOME @{thm Let_def} (*no or one ocurrence of bound variable*)
   48.19    else let (*Norbert Schirmer's case*)
   48.20 -    val ctxt = Simplifier.the_context ss;
   48.21      val thy = Proof_Context.theory_of ctxt;
   48.22      val t = Thm.term_of ct;
   48.23      val ([t'], ctxt') = Variable.import_terms false [t] ctxt;
   48.24 @@ -1258,7 +1257,7 @@
   48.25            val cx = cterm_of thy x;
   48.26            val {T = xT, ...} = rep_cterm cx;
   48.27            val cf = cterm_of thy f;
   48.28 -          val fx_g = Simplifier.rewrite ss (Thm.apply cf cx);
   48.29 +          val fx_g = Simplifier.rewrite ctxt (Thm.apply cf cx);
   48.30            val (_ $ _ $ g) = prop_of fx_g;
   48.31            val g' = abstract_over (x,g);
   48.32            val abs_g'= Abs (n,xT,g');
   48.33 @@ -1345,7 +1344,7 @@
   48.34  lemmas [cong] = imp_cong simp_implies_cong
   48.35  lemmas [split] = split_if
   48.36  
   48.37 -ML {* val HOL_ss = @{simpset} *}
   48.38 +ML {* val HOL_ss = simpset_of @{context} *}
   48.39  
   48.40  text {* Simplifies x assuming c and y assuming ~c *}
   48.41  lemma if_cong:
   48.42 @@ -1482,13 +1481,13 @@
   48.43      addsimprocs
   48.44        [Simplifier.simproc_global @{theory} "swap_induct_false"
   48.45           ["induct_false ==> PROP P ==> PROP Q"]
   48.46 -         (fn _ => fn _ =>
   48.47 +         (fn _ =>
   48.48              (fn _ $ (P as _ $ @{const induct_false}) $ (_ $ Q $ _) =>
   48.49                    if P <> Q then SOME Drule.swap_prems_eq else NONE
   48.50                | _ => NONE)),
   48.51         Simplifier.simproc_global @{theory} "induct_equal_conj_curry"
   48.52           ["induct_conj P Q ==> PROP R"]
   48.53 -         (fn _ => fn _ =>
   48.54 +         (fn _ =>
   48.55              (fn _ $ (_ $ P) $ _ =>
   48.56                  let
   48.57                    fun is_conj (@{const induct_conj} $ P $ Q) =
   48.58 @@ -1583,7 +1582,7 @@
   48.59  signature REORIENT_PROC =
   48.60  sig
   48.61    val add : (term -> bool) -> theory -> theory
   48.62 -  val proc : morphism -> simpset -> cterm -> thm option
   48.63 +  val proc : morphism -> Proof.context -> cterm -> thm option
   48.64  end;
   48.65  
   48.66  structure Reorient_Proc : REORIENT_PROC =
   48.67 @@ -1599,9 +1598,8 @@
   48.68    fun matches thy t = exists (fn (m, _) => m t) (Data.get thy);
   48.69  
   48.70    val meta_reorient = @{thm eq_commute [THEN eq_reflection]};
   48.71 -  fun proc phi ss ct =
   48.72 +  fun proc phi ctxt ct =
   48.73      let
   48.74 -      val ctxt = Simplifier.the_context ss;
   48.75        val thy = Proof_Context.theory_of ctxt;
   48.76      in
   48.77        case Thm.term_of ct of
   48.78 @@ -1701,9 +1699,9 @@
   48.79  subsubsection {* Generic code generator preprocessor setup *}
   48.80  
   48.81  setup {*
   48.82 -  Code_Preproc.map_pre (K HOL_basic_ss)
   48.83 -  #> Code_Preproc.map_post (K HOL_basic_ss)
   48.84 -  #> Code_Simp.map_ss (K HOL_basic_ss)
   48.85 +  Code_Preproc.map_pre (put_simpset HOL_basic_ss)
   48.86 +  #> Code_Preproc.map_post (put_simpset HOL_basic_ss)
   48.87 +  #> Code_Simp.map_ss (put_simpset HOL_basic_ss)
   48.88  *}
   48.89  
   48.90  subsubsection {* Equality *}
   48.91 @@ -1728,10 +1726,9 @@
   48.92  declare eq_equal [code]
   48.93  
   48.94  setup {*
   48.95 -  Code_Preproc.map_pre (fn simpset =>
   48.96 -    simpset addsimprocs [Simplifier.simproc_global_i @{theory} "equal" [@{term HOL.eq}]
   48.97 -      (fn thy => fn _ =>
   48.98 -        fn Const (_, Type ("fun", [Type _, _])) => SOME @{thm eq_equal} | _ => NONE)])
   48.99 +  Code_Preproc.map_pre (fn ctxt =>
  48.100 +    ctxt addsimprocs [Simplifier.simproc_global_i @{theory} "equal" [@{term HOL.eq}]
  48.101 +      (fn _ => fn Const (_, Type ("fun", [Type _, _])) => SOME @{thm eq_equal} | _ => NONE)])
  48.102  *}
  48.103  
  48.104  
  48.105 @@ -1994,7 +1991,8 @@
  48.106    fun smp_tac j = EVERY'[dresolve_tac (smp j), atac];
  48.107  end;
  48.108  
  48.109 -val nnf_conv = Simplifier.rewrite (HOL_basic_ss addsimps @{thms simp_thms nnf_simps});
  48.110 +fun nnf_conv ctxt =
  48.111 +  Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms nnf_simps});
  48.112  *}
  48.113  
  48.114  hide_const (open) eq equal
    49.1 --- a/src/HOL/HOLCF/Cfun.thy	Tue Apr 16 17:54:14 2013 +0200
    49.2 +++ b/src/HOL/HOLCF/Cfun.thy	Thu Apr 18 17:07:01 2013 +0200
    49.3 @@ -140,14 +140,14 @@
    49.4  *}
    49.5  
    49.6  simproc_setup beta_cfun_proc ("Rep_cfun (Abs_cfun f)") = {*
    49.7 -  fn phi => fn ss => fn ct =>
    49.8 +  fn phi => fn ctxt => fn ct =>
    49.9      let
   49.10        val dest = Thm.dest_comb;
   49.11        val f = (snd o dest o snd o dest) ct;
   49.12        val [T, U] = Thm.dest_ctyp (ctyp_of_term f);
   49.13        val tr = instantiate' [SOME T, SOME U] [SOME f]
   49.14            (mk_meta_eq @{thm Abs_cfun_inverse2});
   49.15 -      val rules = Cont2ContData.get (Simplifier.the_context ss);
   49.16 +      val rules = Cont2ContData.get ctxt;
   49.17        val tac = SOLVED' (REPEAT_ALL_NEW (match_tac rules));
   49.18      in SOME (perhaps (SINGLE (tac 1)) tr) end
   49.19  *}
    50.1 --- a/src/HOL/HOLCF/IOA/ABP/Correctness.thy	Tue Apr 16 17:54:14 2013 +0200
    50.2 +++ b/src/HOL/HOLCF/IOA/ABP/Correctness.thy	Thu Apr 18 17:07:01 2013 +0200
    50.3 @@ -84,10 +84,9 @@
    50.4  lemma last_ind_on_first:
    50.5      "l ~= [] ==> hd (reverse (reduce (a # l))) = hd (reverse (reduce l))"
    50.6    apply simp
    50.7 -  apply (tactic {* auto_tac (map_simpset (fn _ =>
    50.8 -    HOL_ss
    50.9 +  apply (tactic {* auto_tac (put_simpset HOL_ss @{context}
   50.10      addsimps (@{thms reverse.simps} @ [@{thm hd_append}, @{thm rev_red_not_nil}])
   50.11 -    |> Splitter.add_split @{thm list.split}) @{context}) *})
   50.12 +    |> Splitter.add_split @{thm list.split}) *})
   50.13    done
   50.14  
   50.15  text {* Main Lemma 1 for @{text "S_pkt"} in showing that reduce is refinement. *}
   50.16 @@ -166,16 +165,18 @@
   50.17  
   50.18  lemma sender_abstraction: "is_weak_ref_map reduce srch_ioa srch_fin_ioa"
   50.19  apply (tactic {*
   50.20 -  simp_tac (HOL_ss addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
   50.21 -    @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
   50.22 -    @{thm channel_abstraction}]) 1 *})
   50.23 +  simp_tac (put_simpset HOL_ss @{context}
   50.24 +    addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
   50.25 +      @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
   50.26 +      @{thm channel_abstraction}]) 1 *})
   50.27  done
   50.28  
   50.29  lemma receiver_abstraction: "is_weak_ref_map reduce rsch_ioa rsch_fin_ioa"
   50.30  apply (tactic {*
   50.31 -  simp_tac (HOL_ss addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
   50.32 -    @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
   50.33 -    @{thm channel_abstraction}]) 1 *})
   50.34 +  simp_tac (put_simpset HOL_ss @{context}
   50.35 +    addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
   50.36 +      @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
   50.37 +      @{thm channel_abstraction}]) 1 *})
   50.38  done
   50.39  
   50.40  
    51.1 --- a/src/HOL/HOLCF/IOA/NTP/Impl.thy	Tue Apr 16 17:54:14 2013 +0200
    51.2 +++ b/src/HOL/HOLCF/IOA/NTP/Impl.thy	Thu Apr 18 17:07:01 2013 +0200
    51.3 @@ -102,13 +102,15 @@
    51.4  3) renname_ss unfolds transitions and the abstract channel *)
    51.5  
    51.6  ML {*
    51.7 -val ss = @{simpset} addsimps @{thms "transitions"};
    51.8 -val rename_ss = ss addsimps @{thms unfold_renaming};
    51.9 +val ss = simpset_of (@{context} addsimps @{thms "transitions"});
   51.10 +val rename_ss = simpset_of (put_simpset ss @{context} addsimps @{thms unfold_renaming});
   51.11  
   51.12 -val tac =
   51.13 -  asm_simp_tac (ss |> Simplifier.add_cong @{thm conj_cong} |> Splitter.add_split @{thm split_if})
   51.14 -val tac_ren =
   51.15 -  asm_simp_tac (rename_ss |> Simplifier.add_cong @{thm conj_cong} |> Splitter.add_split @{thm split_if})
   51.16 +fun tac ctxt =
   51.17 +  asm_simp_tac (put_simpset ss ctxt
   51.18 +    |> Simplifier.add_cong @{thm conj_cong} |> Splitter.add_split @{thm split_if})
   51.19 +fun tac_ren ctxt =
   51.20 +  asm_simp_tac (put_simpset rename_ss ctxt
   51.21 +    |> Simplifier.add_cong @{thm conj_cong} |> Splitter.add_split @{thm split_if})
   51.22  *}
   51.23  
   51.24  
   51.25 @@ -129,34 +131,34 @@
   51.26  apply (simp add: Impl.inv1_def split del: split_if)
   51.27  apply (induct_tac a)
   51.28  
   51.29 -apply (tactic "EVERY1[tac, tac, tac, tac]")
   51.30 -apply (tactic "tac 1")
   51.31 -apply (tactic "tac_ren 1")
   51.32 +apply (tactic "EVERY1[tac @{context}, tac @{context}, tac @{context}, tac @{context}]")
   51.33 +apply (tactic "tac @{context} 1")
   51.34 +apply (tactic "tac_ren @{context} 1")
   51.35  
   51.36  txt {* 5 + 1 *}
   51.37  
   51.38 -apply (tactic "tac 1")
   51.39 -apply (tactic "tac_ren 1")
   51.40 +apply (tactic "tac @{context} 1")
   51.41 +apply (tactic "tac_ren @{context} 1")
   51.42  
   51.43  txt {* 4 + 1 *}
   51.44 -apply (tactic {* EVERY1[tac, tac, tac, tac] *})
   51.45 +apply (tactic {* EVERY1[tac @{context}, tac @{context}, tac @{context}, tac @{context}] *})
   51.46  
   51.47  
   51.48  txt {* Now the other half *}
   51.49  apply (simp add: Impl.inv1_def split del: split_if)
   51.50  apply (induct_tac a)
   51.51 -apply (tactic "EVERY1 [tac, tac]")
   51.52 +apply (tactic "EVERY1 [tac @{context}, tac @{context}]")
   51.53  
   51.54  txt {* detour 1 *}
   51.55 -apply (tactic "tac 1")
   51.56 -apply (tactic "tac_ren 1")
   51.57 +apply (tactic "tac @{context} 1")
   51.58 +apply (tactic "tac_ren @{context} 1")
   51.59  apply (rule impI)
   51.60  apply (erule conjE)+
   51.61  apply (simp (no_asm_simp) add: hdr_sum_def Multiset.count_def Multiset.countm_nonempty_def
   51.62    split add: split_if)
   51.63  txt {* detour 2 *}
   51.64 -apply (tactic "tac 1")
   51.65 -apply (tactic "tac_ren 1")
   51.66 +apply (tactic "tac @{context} 1")
   51.67 +apply (tactic "tac_ren @{context} 1")
   51.68  apply (rule impI)
   51.69  apply (erule conjE)+
   51.70  apply (simp add: Impl.hdr_sum_def Multiset.count_def Multiset.countm_nonempty_def
   51.71 @@ -181,7 +183,8 @@
   51.72  apply (rule countm_spurious_delm)
   51.73  apply (simp (no_asm))
   51.74  
   51.75 -apply (tactic "EVERY1 [tac, tac, tac, tac, tac, tac]")
   51.76 +apply (tactic "EVERY1 [tac @{context}, tac @{context}, tac @{context},
   51.77 +  tac @{context}, tac @{context}, tac @{context}]")
   51.78  
   51.79  done
   51.80  
   51.81 @@ -200,7 +203,7 @@
   51.82  
   51.83    txt {* 10 cases. First 4 are simple, since state doesn't change *}
   51.84  
   51.85 -  ML_prf {* val tac2 = asm_full_simp_tac (ss addsimps [@{thm inv2_def}]) *}
   51.86 +  ML_prf {* val tac2 = asm_full_simp_tac (put_simpset ss @{context} addsimps [@{thm inv2_def}]) *}
   51.87  
   51.88    txt {* 10 - 7 *}
   51.89    apply (tactic "EVERY1 [tac2,tac2,tac2,tac2]")
   51.90 @@ -256,13 +259,13 @@
   51.91    apply (simp (no_asm_simp) add: impl_ioas split del: split_if)
   51.92    apply (induct_tac "a")
   51.93  
   51.94 -  ML_prf {* val tac3 = asm_full_simp_tac (ss addsimps [@{thm inv3_def}]) *}
   51.95 +  ML_prf {* val tac3 = asm_full_simp_tac (put_simpset ss @{context} addsimps [@{thm inv3_def}]) *}
   51.96  
   51.97    txt {* 10 - 8 *}
   51.98  
   51.99    apply (tactic "EVERY1[tac3,tac3,tac3]")
  51.100  
  51.101 -  apply (tactic "tac_ren 1")
  51.102 +  apply (tactic "tac_ren @{context} 1")
  51.103    apply (intro strip, (erule conjE)+)
  51.104    apply hypsubst
  51.105    apply (erule exE)
  51.106 @@ -270,7 +273,7 @@
  51.107  
  51.108    txt {* 7 *}
  51.109    apply (tactic "tac3 1")
  51.110 -  apply (tactic "tac_ren 1")
  51.111 +  apply (tactic "tac_ren @{context} 1")
  51.112    apply force
  51.113  
  51.114    txt {* 6 - 3 *}
  51.115 @@ -278,7 +281,7 @@
  51.116    apply (tactic "EVERY1[tac3,tac3,tac3,tac3]")
  51.117  
  51.118    txt {* 2 *}
  51.119 -  apply (tactic "asm_full_simp_tac ss 1")
  51.120 +  apply (tactic "asm_full_simp_tac (put_simpset ss @{context}) 1")
  51.121    apply (simp (no_asm) add: inv3_def)
  51.122    apply (intro strip, (erule conjE)+)
  51.123    apply (rule imp_disjL [THEN iffD1])
  51.124 @@ -321,7 +324,7 @@
  51.125    apply (simp (no_asm_simp) add: impl_ioas split del: split_if)
  51.126    apply (induct_tac "a")
  51.127  
  51.128 -  ML_prf {* val tac4 =  asm_full_simp_tac (ss addsimps [@{thm inv4_def}]) *}
  51.129 +  ML_prf {* val tac4 =  asm_full_simp_tac (put_simpset ss @{context} addsimps [@{thm inv4_def}]) *}
  51.130  
  51.131    txt {* 10 - 2 *}
  51.132  
    52.1 --- a/src/HOL/HOLCF/IOA/meta_theory/Abstraction.thy	Tue Apr 16 17:54:14 2013 +0200
    52.2 +++ b/src/HOL/HOLCF/IOA/meta_theory/Abstraction.thy	Thu Apr 18 17:07:01 2013 +0200
    52.3 @@ -606,8 +606,7 @@
    52.4  fun abstraction_tac ctxt =
    52.5    SELECT_GOAL (auto_tac
    52.6      (ctxt addSIs @{thms weak_strength_lemmas}
    52.7 -      |> map_simpset (fn ss =>
    52.8 -        ss addsimps [@{thm state_strengthening_def}, @{thm state_weakening_def}])))
    52.9 +      addsimps [@{thm state_strengthening_def}, @{thm state_weakening_def}]))
   52.10  *}
   52.11  
   52.12  method_setup abstraction = {* Scan.succeed (SIMPLE_METHOD' o abstraction_tac) *}
    53.1 --- a/src/HOL/HOLCF/IOA/meta_theory/CompoScheds.thy	Tue Apr 16 17:54:14 2013 +0200
    53.2 +++ b/src/HOL/HOLCF/IOA/meta_theory/CompoScheds.thy	Thu Apr 18 17:07:01 2013 +0200
    53.3 @@ -295,20 +295,18 @@
    53.4  in
    53.5  
    53.6  fun mkex_induct_tac ctxt sch exA exB =
    53.7 -  let val ss = simpset_of ctxt in
    53.8 -    EVERY'[Seq_induct_tac ctxt sch defs,
    53.9 -           asm_full_simp_tac ss,
   53.10 -           SELECT_GOAL (safe_tac @{theory_context Fun}),
   53.11 -           Seq_case_simp_tac ctxt exA,
   53.12 -           Seq_case_simp_tac ctxt exB,
   53.13 -           asm_full_simp_tac ss,
   53.14 -           Seq_case_simp_tac ctxt exA,
   53.15 -           asm_full_simp_tac ss,
   53.16 -           Seq_case_simp_tac ctxt exB,
   53.17 -           asm_full_simp_tac ss,
   53.18 -           asm_full_simp_tac (ss addsimps asigs)
   53.19 -          ]
   53.20 -  end
   53.21 +  EVERY'[Seq_induct_tac ctxt sch defs,
   53.22 +         asm_full_simp_tac ctxt,
   53.23 +         SELECT_GOAL (safe_tac @{theory_context Fun}),
   53.24 +         Seq_case_simp_tac ctxt exA,
   53.25 +         Seq_case_simp_tac ctxt exB,
   53.26 +         asm_full_simp_tac ctxt,
   53.27 +         Seq_case_simp_tac ctxt exA,
   53.28 +         asm_full_simp_tac ctxt,
   53.29 +         Seq_case_simp_tac ctxt exB,
   53.30 +         asm_full_simp_tac ctxt,
   53.31 +         asm_full_simp_tac (ctxt addsimps asigs)
   53.32 +        ]
   53.33  
   53.34  end
   53.35  *}
    54.1 --- a/src/HOL/HOLCF/IOA/meta_theory/Sequence.thy	Tue Apr 16 17:54:14 2013 +0200
    54.2 +++ b/src/HOL/HOLCF/IOA/meta_theory/Sequence.thy	Thu Apr 18 17:07:01 2013 +0200
    54.3 @@ -1086,37 +1086,31 @@
    54.4  
    54.5  (* on a>>s only simp_tac, as full_simp_tac is uncomplete and often causes errors *)
    54.6  fun Seq_case_simp_tac ctxt s i =
    54.7 -  let val ss = simpset_of ctxt in
    54.8 -    Seq_case_tac ctxt s i
    54.9 -    THEN asm_simp_tac ss (i+2)
   54.10 -    THEN asm_full_simp_tac ss (i+1)
   54.11 -    THEN asm_full_simp_tac ss i
   54.12 -  end;
   54.13 +  Seq_case_tac ctxt s i
   54.14 +  THEN asm_simp_tac ctxt (i+2)
   54.15 +  THEN asm_full_simp_tac ctxt (i+1)
   54.16 +  THEN asm_full_simp_tac ctxt i;
   54.17  
   54.18  (* rws are definitions to be unfolded for admissibility check *)
   54.19  fun Seq_induct_tac ctxt s rws i =
   54.20 -  let val ss = simpset_of ctxt in
   54.21 -    res_inst_tac ctxt [(("x", 0), s)] @{thm Seq_induct} i
   54.22 -    THEN (REPEAT_DETERM (CHANGED (asm_simp_tac ss (i+1))))
   54.23 -    THEN simp_tac (ss addsimps rws) i
   54.24 -  end;
   54.25 +  res_inst_tac ctxt [(("x", 0), s)] @{thm Seq_induct} i
   54.26 +  THEN (REPEAT_DETERM (CHANGED (asm_simp_tac ctxt (i+1))))
   54.27 +  THEN simp_tac (ctxt addsimps rws) i;
   54.28  
   54.29  fun Seq_Finite_induct_tac ctxt i =
   54.30    etac @{thm Seq_Finite_ind} i
   54.31 -  THEN (REPEAT_DETERM (CHANGED (asm_simp_tac (simpset_of ctxt) i)));
   54.32 +  THEN (REPEAT_DETERM (CHANGED (asm_simp_tac ctxt i)));
   54.33  
   54.34  fun pair_tac ctxt s =
   54.35    res_inst_tac ctxt [(("p", 0), s)] @{thm PairE}
   54.36 -  THEN' hyp_subst_tac THEN' asm_full_simp_tac (simpset_of ctxt);
   54.37 +  THEN' hyp_subst_tac THEN' asm_full_simp_tac ctxt;
   54.38  
   54.39  (* induction on a sequence of pairs with pairsplitting and simplification *)
   54.40  fun pair_induct_tac ctxt s rws i =
   54.41 -  let val ss = simpset_of ctxt in
   54.42 -    res_inst_tac ctxt [(("x", 0), s)] @{thm Seq_induct} i
   54.43 -    THEN pair_tac ctxt "a" (i+3)
   54.44 -    THEN (REPEAT_DETERM (CHANGED (simp_tac ss (i+1))))
   54.45 -    THEN simp_tac (ss addsimps rws) i
   54.46 -  end;
   54.47 +  res_inst_tac ctxt [(("x", 0), s)] @{thm Seq_induct} i
   54.48 +  THEN pair_tac ctxt "a" (i+3)
   54.49 +  THEN (REPEAT_DETERM (CHANGED (simp_tac ctxt (i+1))))
   54.50 +  THEN simp_tac (ctxt addsimps rws) i;
   54.51  
   54.52  *}
   54.53  
    55.1 --- a/src/HOL/HOLCF/Lift.thy	Tue Apr 16 17:54:14 2013 +0200
    55.2 +++ b/src/HOL/HOLCF/Lift.thy	Thu Apr 18 17:07:01 2013 +0200
    55.3 @@ -46,7 +46,7 @@
    55.4  
    55.5  method_setup defined = {*
    55.6    Scan.succeed (fn ctxt => SIMPLE_METHOD'
    55.7 -    (etac @{thm lift_definedE} THEN' asm_simp_tac (simpset_of ctxt)))
    55.8 +    (etac @{thm lift_definedE} THEN' asm_simp_tac ctxt))
    55.9  *}
   55.10  
   55.11  lemma DefE: "Def x = \<bottom> \<Longrightarrow> R"
    56.1 --- a/src/HOL/HOLCF/Tools/Domain/domain_constructors.ML	Tue Apr 16 17:54:14 2013 +0200
    56.2 +++ b/src/HOL/HOLCF/Tools/Domain/domain_constructors.ML	Thu Apr 18 17:07:01 2013 +0200
    56.3 @@ -64,13 +64,15 @@
    56.4  
    56.5  (************************** miscellaneous functions ***************************)
    56.6  
    56.7 -val simple_ss = HOL_basic_ss addsimps @{thms simp_thms}
    56.8 +val simple_ss =
    56.9 +  simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms simp_thms})
   56.10  
   56.11  val beta_rules =
   56.12    @{thms beta_cfun cont_id cont_const cont2cont_APP cont2cont_LAM'} @
   56.13    @{thms cont2cont_fst cont2cont_snd cont2cont_Pair}
   56.14  
   56.15 -val beta_ss = HOL_basic_ss addsimps (@{thms simp_thms} @ beta_rules)
   56.16 +val beta_ss =
   56.17 +  simpset_of (put_simpset HOL_basic_ss @{context} addsimps (@{thms simp_thms} @ beta_rules))
   56.18  
   56.19  fun define_consts
   56.20      (specs : (binding * term * mixfix) list)
   56.21 @@ -268,7 +270,7 @@
   56.22                val bottom = mk_bottom (fastype_of v')
   56.23                val vs' = map (fn v => if v = v' then bottom else v) vs
   56.24                val goal = mk_trp (mk_undef (list_ccomb (con, vs')))
   56.25 -              val tacs = [simp_tac (HOL_basic_ss addsimps rules) 1]
   56.26 +              val tacs = [simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1]
   56.27              in prove thy con_betas goal (K tacs) end
   56.28          in map one_strict nonlazy end
   56.29  
   56.30 @@ -282,7 +284,7 @@
   56.31            val goal = mk_trp (iff_disj (lhs, rhss))
   56.32            val rule1 = iso_locale RS @{thm iso.abs_bottom_iff}
   56.33            val rules = rule1 :: @{thms con_bottom_iff_rules}
   56.34 -          val tacs = [simp_tac (HOL_ss addsimps rules) 1]
   56.35 +          val tacs = [simp_tac (Simplifier.global_context thy HOL_ss addsimps rules) 1]
   56.36          in prove thy con_betas goal (K tacs) end
   56.37      in
   56.38        val con_stricts = maps con_strict spec'
   56.39 @@ -313,7 +315,7 @@
   56.40            val rules1 = abs_below :: @{thms sinl_below sinr_below spair_below up_below}
   56.41            val rules2 = @{thms up_defined spair_defined ONE_defined}
   56.42            val rules = rules1 @ rules2
   56.43 -          val tacs = [asm_simp_tac (simple_ss addsimps rules) 1]
   56.44 +          val tacs = [asm_simp_tac (Simplifier.global_context thy simple_ss addsimps rules) 1]
   56.45          in map (fn c => pgterm mk_below c (K tacs)) cons' end
   56.46        val injects =
   56.47          let
   56.48 @@ -321,7 +323,7 @@
   56.49            val rules1 = abs_eq :: @{thms sinl_eq sinr_eq spair_eq up_eq}
   56.50            val rules2 = @{thms up_defined spair_defined ONE_defined}
   56.51            val rules = rules1 @ rules2
   56.52 -          val tacs = [asm_simp_tac (simple_ss addsimps rules) 1]
   56.53 +          val tacs = [asm_simp_tac (Simplifier.global_context thy simple_ss addsimps rules) 1]
   56.54          in map (fn c => pgterm mk_eq c (K tacs)) cons' end
   56.55      end
   56.56  
   56.57 @@ -346,7 +348,7 @@
   56.58            val goal = mk_trp (iff_disj (lhs, rhss))
   56.59            val rule1 = iso_locale RS @{thm iso.abs_below}
   56.60            val rules = rule1 :: @{thms con_below_iff_rules}
   56.61 -          val tacs = [simp_tac (HOL_ss addsimps rules) 1]
   56.62 +          val tacs = [simp_tac (Simplifier.global_context thy HOL_ss addsimps rules) 1]
   56.63          in prove thy con_betas goal (K tacs) end
   56.64        fun dist_eq (con1, args1) (con2, args2) =
   56.65          let
   56.66 @@ -358,7 +360,7 @@
   56.67            val goal = mk_trp (iff_disj2 (lhs, rhss1, rhss2))
   56.68            val rule1 = iso_locale RS @{thm iso.abs_eq}
   56.69            val rules = rule1 :: @{thms con_eq_iff_rules}
   56.70 -          val tacs = [simp_tac (HOL_ss addsimps rules) 1]
   56.71 +          val tacs = [simp_tac (Simplifier.global_context thy HOL_ss addsimps rules) 1]
   56.72          in prove thy con_betas goal (K tacs) end
   56.73      in
   56.74        val dist_les = map_dist dist_le spec'
   56.75 @@ -514,7 +516,7 @@
   56.76            val rules2 = @{thms con_bottom_iff_rules}
   56.77            val rules3 = @{thms cfcomp2 one_case2}
   56.78            val rules = abs_inverse :: rules1 @ rules2 @ rules3
   56.79 -          val tacs = [asm_simp_tac (beta_ss addsimps rules) 1]
   56.80 +          val tacs = [asm_simp_tac (Simplifier.global_context thy beta_ss addsimps rules) 1]
   56.81          in prove thy defs goal (K tacs) end
   56.82      in
   56.83        val case_apps = map2 one_case spec fs
   56.84 @@ -582,7 +584,7 @@
   56.85      val sel_stricts : thm list =
   56.86        let
   56.87          val rules = rep_strict :: @{thms sel_strict_rules}
   56.88 -        val tacs = [simp_tac (HOL_basic_ss addsimps rules) 1]
   56.89 +        val tacs = [simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1]
   56.90          fun sel_strict sel =
   56.91            let
   56.92              val goal = mk_trp (mk_strict sel)
   56.93 @@ -598,7 +600,7 @@
   56.94        let
   56.95          val defs = con_betas @ sel_defs
   56.96          val rules = abs_inv :: @{thms sel_app_rules}
   56.97 -        val tacs = [asm_simp_tac (simple_ss addsimps rules) 1]
   56.98 +        val tacs = [asm_simp_tac (Simplifier.global_context thy simple_ss addsimps rules) 1]
   56.99          fun sel_apps_of (i, (con, args: (bool * term option * typ) list)) =
  56.100            let
  56.101              val Ts : typ list = map #3 args
  56.102 @@ -643,7 +645,7 @@
  56.103      val sel_defins : thm list =
  56.104        let
  56.105          val rules = rep_bottom_iff :: @{thms sel_bottom_iff_rules}
  56.106 -        val tacs = [simp_tac (HOL_basic_ss addsimps rules) 1]
  56.107 +        val tacs = [simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1]
  56.108          fun sel_defin sel =
  56.109            let
  56.110              val (T, U) = dest_cfunT (fastype_of sel)
  56.111 @@ -720,7 +722,7 @@
  56.112            val assms = map (mk_trp o mk_defined) nonlazy
  56.113            val concl = mk_trp (mk_eq (lhs, rhs))
  56.114            val goal = Logic.list_implies (assms, concl)
  56.115 -          val tacs = [asm_simp_tac (beta_ss addsimps case_rews) 1]
  56.116 +          val tacs = [asm_simp_tac (Simplifier.global_context thy beta_ss addsimps case_rews) 1]
  56.117          in prove thy dis_defs goal (K tacs) end
  56.118        fun one_dis (i, dis) =
  56.119            map_index (dis_app (i, dis)) spec
  56.120 @@ -736,9 +738,9 @@
  56.121            val simps = dis_apps @ @{thms dist_eq_tr}
  56.122            val tacs =
  56.123              [rtac @{thm iffI} 1,
  56.124 -             asm_simp_tac (HOL_basic_ss addsimps dis_stricts) 2,
  56.125 +             asm_simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps dis_stricts) 2,
  56.126               rtac exhaust 1, atac 1,
  56.127 -             ALLGOALS (asm_full_simp_tac (simple_ss addsimps simps))]
  56.128 +             ALLGOALS (asm_full_simp_tac (Simplifier.global_context thy simple_ss addsimps simps))]
  56.129            val goal = mk_trp (mk_eq (mk_undef (dis ` x), mk_undef x))
  56.130          in prove thy [] goal (K tacs) end
  56.131      in
  56.132 @@ -809,7 +811,7 @@
  56.133            val (T, (U, V)) = apsnd dest_cfunT (dest_cfunT (fastype_of mat))
  56.134            val k = Free ("k", U)
  56.135            val goal = mk_trp (mk_eq (mat ` mk_bottom T ` k, mk_bottom V))
  56.136 -          val tacs = [asm_simp_tac (beta_ss addsimps case_rews) 1]
  56.137 +          val tacs = [asm_simp_tac (Simplifier.global_context thy beta_ss addsimps case_rews) 1]
  56.138          in prove thy match_defs goal (K tacs) end
  56.139      in
  56.140        val match_stricts = map match_strict match_consts
  56.141 @@ -828,7 +830,7 @@
  56.142            val assms = map (mk_trp o mk_defined) nonlazy
  56.143            val concl = mk_trp (mk_eq (lhs, rhs))
  56.144            val goal = Logic.list_implies (assms, concl)
  56.145 -          val tacs = [asm_simp_tac (beta_ss addsimps case_rews) 1]
  56.146 +          val tacs = [asm_simp_tac (Simplifier.global_context thy beta_ss addsimps case_rews) 1]
  56.147          in prove thy match_defs goal (K tacs) end
  56.148        fun one_match (i, mat) =
  56.149            map_index (match_app (i, mat)) spec
    57.1 --- a/src/HOL/HOLCF/Tools/Domain/domain_induction.ML	Tue Apr 16 17:54:14 2013 +0200
    57.2 +++ b/src/HOL/HOLCF/Tools/Domain/domain_induction.ML	Thu Apr 18 17:07:01 2013 +0200
    57.3 @@ -71,7 +71,7 @@
    57.4            val rules =
    57.5                [abs_inverse] @ con_betas @ @{thms take_con_rules}
    57.6                @ take_Suc_thms @ deflation_thms @ deflation_take_thms
    57.7 -          val tac = simp_tac (HOL_basic_ss addsimps rules) 1
    57.8 +          val tac = simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1
    57.9          in
   57.10            Goal.prove_global thy [] [] goal (K tac)
   57.11          end
   57.12 @@ -132,7 +132,8 @@
   57.13        mk_trp (p $ HOLCF_Library.mk_bottom T) :: map (con_assm true p) cons
   57.14    val assms = maps eq_assms (Ps ~~ newTs ~~ map #con_specs constr_infos)
   57.15  
   57.16 -  val take_ss = HOL_ss addsimps (@{thm Rep_cfun_strict1} :: take_rews)
   57.17 +  val take_ss =
   57.18 +    simpset_of (put_simpset HOL_ss @{context} addsimps (@{thm Rep_cfun_strict1} :: take_rews))
   57.19    fun quant_tac ctxt i = EVERY
   57.20      (map (fn name => res_inst_tac ctxt [(("x", 0), name)] spec i) x_names)
   57.21  
   57.22 @@ -157,7 +158,7 @@
   57.23              let
   57.24                val subgoal = con_assm false p (con, args)
   57.25                val rules = prems @ con_rews @ @{thms simp_thms}
   57.26 -              val simplify = asm_simp_tac (HOL_basic_ss addsimps rules)
   57.27 +              val simplify = asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps rules)
   57.28                fun arg_tac (lazy, _) =
   57.29                    rtac (if lazy then allI else case_UU_allI) 1
   57.30                val tacs =
   57.31 @@ -173,16 +174,16 @@
   57.32  
   57.33            val tacs1 = [
   57.34              quant_tac ctxt 1,
   57.35 -            simp_tac HOL_ss 1,
   57.36 +            simp_tac (put_simpset HOL_ss ctxt) 1,
   57.37              Induct_Tacs.induct_tac ctxt [[SOME "n"]] 1,
   57.38 -            simp_tac (take_ss addsimps prems) 1,
   57.39 +            simp_tac (put_simpset take_ss ctxt addsimps prems) 1,
   57.40              TRY (safe_tac (put_claset HOL_cs ctxt))]
   57.41            fun con_tac _ = 
   57.42 -            asm_simp_tac take_ss 1 THEN
   57.43 +            asm_simp_tac (put_simpset take_ss ctxt) 1 THEN
   57.44              (resolve_tac prems' THEN_ALL_NEW etac spec) 1
   57.45            fun cases_tacs (cons, exhaust) =
   57.46              res_inst_tac ctxt [(("y", 0), "x")] exhaust 1 ::
   57.47 -            asm_simp_tac (take_ss addsimps prems) 1 ::
   57.48 +            asm_simp_tac (put_simpset take_ss ctxt addsimps prems) 1 ::
   57.49              map con_tac cons
   57.50            val tacs = tacs1 @ maps cases_tacs (conss ~~ exhausts)
   57.51          in
   57.52 @@ -325,10 +326,10 @@
   57.53            val dests = map (fn th => th RS spec RS spec RS mp) prems'
   57.54            fun one_tac (dest, rews) =
   57.55                dtac dest 1 THEN safe_tac (put_claset HOL_cs ctxt) THEN
   57.56 -              ALLGOALS (asm_simp_tac (HOL_basic_ss addsimps rews))
   57.57 +              ALLGOALS (asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps rews))
   57.58          in
   57.59            rtac @{thm nat.induct} 1 THEN
   57.60 -          simp_tac (HOL_ss addsimps rules) 1 THEN
   57.61 +          simp_tac (put_simpset HOL_ss ctxt addsimps rules) 1 THEN
   57.62            safe_tac (put_claset HOL_cs ctxt) THEN
   57.63            EVERY (map one_tac (dests ~~ take_rews))
   57.64          end
   57.65 @@ -344,12 +345,12 @@
   57.66        val assm1 = mk_trp (list_comb (bisim_const, Rs))
   57.67        val assm2 = mk_trp (R $ x $ y)
   57.68        val goal = mk_trp (mk_eq (x, y))
   57.69 -      fun tacf {prems, context = _} =
   57.70 +      fun tacf {prems, context = ctxt} =
   57.71          let
   57.72            val rule = hd prems RS coind_lemma
   57.73          in
   57.74            rtac take_lemma 1 THEN
   57.75 -          asm_simp_tac (HOL_basic_ss addsimps (rule :: prems)) 1
   57.76 +          asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps (rule :: prems)) 1
   57.77          end
   57.78      in
   57.79        Goal.prove_global thy [] [assm1, assm2] goal tacf
    58.1 --- a/src/HOL/HOLCF/Tools/Domain/domain_isomorphism.ML	Tue Apr 16 17:54:14 2013 +0200
    58.2 +++ b/src/HOL/HOLCF/Tools/Domain/domain_isomorphism.ML	Thu Apr 18 17:07:01 2013 +0200
    58.3 @@ -36,7 +36,8 @@
    58.4  struct
    58.5  
    58.6  val beta_ss =
    58.7 -  HOL_basic_ss addsimps @{thms simp_thms} addsimprocs [@{simproc beta_cfun_proc}]
    58.8 +  simpset_of (put_simpset HOL_basic_ss @{context}
    58.9 +    addsimps @{thms simp_thms} addsimprocs [@{simproc beta_cfun_proc}])
   58.10  
   58.11  fun is_cpo thy T = Sign.of_sort thy (T, @{sort cpo})
   58.12  
   58.13 @@ -156,7 +157,8 @@
   58.14      (* prove applied version of definitions *)
   58.15      fun prove_proj (lhs, rhs) =
   58.16        let
   58.17 -        val tac = rewrite_goals_tac fixdef_thms THEN (simp_tac beta_ss) 1
   58.18 +        val tac = rewrite_goals_tac fixdef_thms THEN
   58.19 +          (simp_tac (Simplifier.global_context thy beta_ss)) 1
   58.20          val goal = Logic.mk_equals (lhs, rhs)
   58.21        in Goal.prove_global thy [] [] goal (K tac) end
   58.22      val proj_thms = map prove_proj projs
   58.23 @@ -324,13 +326,13 @@
   58.24            @ deflation_abs_rep_thms
   58.25            @ Domain_Take_Proofs.get_deflation_thms thy
   58.26        in
   58.27 -        Goal.prove_global thy [] assms goal (fn {prems, ...} =>
   58.28 +        Goal.prove_global thy [] assms goal (fn {prems, context = ctxt} =>
   58.29           EVERY
   58.30            [rewrite_goals_tac map_apply_thms,
   58.31             rtac (map_cont_thm RS @{thm cont_fix_ind}) 1,
   58.32             REPEAT (resolve_tac adm_rules 1),
   58.33 -           simp_tac (HOL_basic_ss addsimps bottom_rules) 1,
   58.34 -           simp_tac (HOL_basic_ss addsimps tuple_rules) 1,
   58.35 +           simp_tac (put_simpset HOL_basic_ss ctxt addsimps bottom_rules) 1,
   58.36 +           simp_tac (put_simpset HOL_basic_ss ctxt addsimps tuple_rules) 1,
   58.37             REPEAT (etac @{thm conjE} 1),
   58.38             REPEAT (resolve_tac (deflation_rules @ prems) 1 ORELSE atac 1)])
   58.39        end
   58.40 @@ -638,15 +640,15 @@
   58.41            @ isodefl_abs_rep_thms
   58.42            @ IsodeflData.get (Proof_Context.init_global thy)
   58.43        in
   58.44 -        Goal.prove_global thy [] assms goal (fn {prems, ...} =>
   58.45 +        Goal.prove_global thy [] assms goal (fn {prems, context = ctxt} =>
   58.46           EVERY
   58.47            [rewrite_goals_tac (defl_apply_thms @ map_apply_thms),
   58.48             rtac (@{thm cont_parallel_fix_ind}
   58.49               OF [defl_cont_thm, map_cont_thm]) 1,
   58.50             REPEAT (resolve_tac adm_rules 1),
   58.51 -           simp_tac (HOL_basic_ss addsimps bottom_rules) 1,
   58.52 -           simp_tac (HOL_basic_ss addsimps tuple_rules) 1,
   58.53 -           simp_tac (HOL_basic_ss addsimps map_ID_simps) 1,
   58.54 +           simp_tac (put_simpset HOL_basic_ss ctxt addsimps bottom_rules) 1,
   58.55 +           simp_tac (put_simpset HOL_basic_ss ctxt addsimps tuple_rules) 1,
   58.56 +           simp_tac (put_simpset HOL_basic_ss ctxt addsimps map_ID_simps) 1,
   58.57             REPEAT (etac @{thm conjE} 1),
   58.58             REPEAT (resolve_tac (isodefl_rules @ prems) 1 ORELSE atac 1)])
   58.59        end
   58.60 @@ -712,16 +714,16 @@
   58.61          val rules1 =
   58.62              @{thms iterate_Suc prod_eq_iff fst_conv snd_conv}
   58.63              @ take_Suc_thms
   58.64 -        val tac =
   58.65 +        fun tac ctxt =
   58.66              EVERY
   58.67 -            [simp_tac (HOL_basic_ss addsimps start_rules) 1,
   58.68 -             simp_tac (HOL_basic_ss addsimps @{thms fix_def2}) 1,
   58.69 +            [simp_tac (put_simpset HOL_basic_ss ctxt addsimps start_rules) 1,
   58.70 +             simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms fix_def2}) 1,
   58.71               rtac @{thm lub_eq} 1,
   58.72               rtac @{thm nat.induct} 1,
   58.73 -             simp_tac (HOL_basic_ss addsimps rules0) 1,
   58.74 -             asm_full_simp_tac (beta_ss addsimps rules1) 1]
   58.75 +             simp_tac (put_simpset HOL_basic_ss ctxt addsimps rules0) 1,
   58.76 +             asm_full_simp_tac (put_simpset beta_ss ctxt addsimps rules1) 1]
   58.77        in
   58.78 -        Goal.prove_global thy [] [] goal (K tac)
   58.79 +        Goal.prove_global thy [] [] goal (tac o #context)
   58.80        end
   58.81  
   58.82      (* prove lub of take equals ID *)
    59.1 --- a/src/HOL/HOLCF/Tools/Domain/domain_take_proofs.ML	Tue Apr 16 17:54:14 2013 +0200
    59.2 +++ b/src/HOL/HOLCF/Tools/Domain/domain_take_proofs.ML	Thu Apr 18 17:07:01 2013 +0200
    59.3 @@ -108,7 +108,8 @@
    59.4    }
    59.5  
    59.6  val beta_ss =
    59.7 -  HOL_basic_ss addsimps @{thms simp_thms} addsimprocs [@{simproc beta_cfun_proc}]
    59.8 +  simpset_of (put_simpset HOL_basic_ss @{context}
    59.9 +    addsimps @{thms simp_thms} addsimprocs [@{simproc beta_cfun_proc}])
   59.10  
   59.11  (******************************************************************************)
   59.12  (******************************** theory data *********************************)
   59.13 @@ -272,7 +273,7 @@
   59.14        let
   59.15          val goal = mk_trp (mk_chain take_const)
   59.16          val rules = take_defs @ @{thms chain_iterate ch2ch_fst ch2ch_snd}
   59.17 -        val tac = simp_tac (HOL_basic_ss addsimps rules) 1
   59.18 +        val tac = simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1
   59.19          val thm = Goal.prove_global thy [] [] goal (K tac)
   59.20        in
   59.21          add_qualified_simp_thm "chain_take" (dbind, thm) thy
   59.22 @@ -286,7 +287,7 @@
   59.23          val lhs = take_const $ @{term "0::nat"}
   59.24          val goal = mk_eqs (lhs, mk_bottom (lhsT ->> lhsT))
   59.25          val rules = take_defs @ @{thms iterate_0 fst_strict snd_strict}
   59.26 -        val tac = simp_tac (HOL_basic_ss addsimps rules) 1
   59.27 +        val tac = simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps rules) 1
   59.28          val take_0_thm = Goal.prove_global thy [] [] goal (K tac)
   59.29        in
   59.30          add_qualified_simp_thm "take_0" (dbind, take_0_thm) thy
   59.31 @@ -306,7 +307,7 @@
   59.32          val goal = mk_eqs (lhs, rhs)
   59.33          val simps = @{thms iterate_Suc fst_conv snd_conv}
   59.34          val rules = take_defs @ simps
   59.35 -        val tac = simp_tac (beta_ss addsimps rules) 1
   59.36 +        val tac = simp_tac (Simplifier.global_context thy beta_ss addsimps rules) 1
   59.37          val take_Suc_thm = Goal.prove_global thy [] [] goal (K tac)
   59.38        in
   59.39          add_qualified_thm "take_Suc" (dbind, take_Suc_thm) thy
   59.40 @@ -332,8 +333,8 @@
   59.41          Goal.prove_global thy [] [] goal (fn _ =>
   59.42           EVERY
   59.43            [rtac @{thm nat.induct} 1,
   59.44 -           simp_tac (HOL_basic_ss addsimps bottom_rules) 1,
   59.45 -           asm_simp_tac (HOL_basic_ss addsimps take_Suc_thms) 1,
   59.46 +           simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps bottom_rules) 1,
   59.47 +           asm_simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps take_Suc_thms) 1,
   59.48             REPEAT (etac @{thm conjE} 1
   59.49                     ORELSE resolve_tac deflation_rules 1
   59.50                     ORELSE atac 1)])
   59.51 @@ -456,8 +457,8 @@
   59.52              @ @{thms decisive_ID decisive_ssum_map decisive_sprod_map}
   59.53          val tac = EVERY [
   59.54              rtac @{thm nat.induct} 1,
   59.55 -            simp_tac (HOL_ss addsimps rules0) 1,
   59.56 -            asm_simp_tac (HOL_ss addsimps rules1) 1]
   59.57 +            simp_tac (Simplifier.global_context thy HOL_ss addsimps rules0) 1,
   59.58 +            asm_simp_tac (Simplifier.global_context thy HOL_ss addsimps rules1) 1]
   59.59        in Goal.prove_global thy [] [] goal (K tac) end
   59.60      fun conjuncts 1 thm = [thm]
   59.61        | conjuncts n thm = let
    60.1 --- a/src/HOL/HOLCF/Tools/cont_proc.ML	Tue Apr 16 17:54:14 2013 +0200
    60.2 +++ b/src/HOL/HOLCF/Tools/cont_proc.ML	Thu Apr 18 17:07:01 2013 +0200
    60.3 @@ -119,8 +119,9 @@
    60.4    end
    60.5  
    60.6  local
    60.7 -  fun solve_cont thy _ t =
    60.8 +  fun solve_cont ctxt t =
    60.9      let
   60.10 +      val thy = Proof_Context.theory_of ctxt
   60.11        val tr = instantiate' [] [SOME (cterm_of thy t)] @{thm Eq_TrueI}
   60.12      in Option.map fst (Seq.pull (cont_tac 1 tr)) end
   60.13  in
   60.14 @@ -128,6 +129,6 @@
   60.15      Simplifier.simproc_global thy "cont_proc" ["cont f"] solve_cont
   60.16  end
   60.17  
   60.18 -fun setup thy = Simplifier.map_simpset_global (fn ss => ss addsimprocs [cont_proc thy]) thy
   60.19 +fun setup thy = map_theory_simpset (fn ctxt => ctxt addsimprocs [cont_proc thy]) thy
   60.20  
   60.21  end
    61.1 --- a/src/HOL/HOLCF/Tools/fixrec.ML	Tue Apr 16 17:54:14 2013 +0200
    61.2 +++ b/src/HOL/HOLCF/Tools/fixrec.ML	Thu Apr 18 17:07:01 2013 +0200
    61.3 @@ -132,7 +132,7 @@
    61.4            Syntax.string_of_term lthy prop)
    61.5          val rules = Cont2ContData.get lthy
    61.6          val fast_tac = SOLVED' (REPEAT_ALL_NEW (match_tac rules))
    61.7 -        val slow_tac = SOLVED' (simp_tac (simpset_of lthy))
    61.8 +        val slow_tac = SOLVED' (simp_tac lthy)
    61.9          val tac = fast_tac 1 ORELSE slow_tac 1 ORELSE err
   61.10        in
   61.11          Goal.prove lthy [] [] prop (K tac)
   61.12 @@ -293,7 +293,6 @@
   61.13  fun fixrec_simp_tac ctxt =
   61.14    let
   61.15      val tab = FixrecUnfoldData.get (Context.Proof ctxt)
   61.16 -    val ss = Simplifier.simpset_of ctxt
   61.17      val concl = HOLogic.dest_Trueprop o Logic.strip_imp_concl o strip_alls
   61.18      fun tac (t, i) =
   61.19        let
   61.20 @@ -302,7 +301,7 @@
   61.21          val unfold_thm = the (Symtab.lookup tab c)
   61.22          val rule = unfold_thm RS @{thm ssubst_lhs}
   61.23        in
   61.24 -        CHANGED (rtac rule i THEN eta_tac i THEN asm_simp_tac ss i)
   61.25 +        CHANGED (rtac rule i THEN eta_tac i THEN asm_simp_tac ctxt i)
   61.26        end
   61.27    in
   61.28      SUBGOAL (fn ti => the_default no_tac (try tac ti))
   61.29 @@ -311,9 +310,8 @@
   61.30  (* proves a block of pattern matching equations as theorems, using unfold *)
   61.31  fun make_simps ctxt (unfold_thm, eqns : (Attrib.binding * term) list) =
   61.32    let
   61.33 -    val ss = Simplifier.simpset_of ctxt
   61.34      val rule = unfold_thm RS @{thm ssubst_lhs}
   61.35 -    val tac = rtac rule 1 THEN eta_tac 1 THEN asm_simp_tac ss 1
   61.36 +    val tac = rtac rule 1 THEN eta_tac 1 THEN asm_simp_tac ctxt 1
   61.37      fun prove_term t = Goal.prove ctxt [] [] t (K tac)
   61.38      fun prove_eqn (bind, eqn_t) = (bind, prove_term eqn_t)
   61.39    in
    62.1 --- a/src/HOL/HOLCF/Tr.thy	Tue Apr 16 17:54:14 2013 +0200
    62.2 +++ b/src/HOL/HOLCF/Tr.thy	Thu Apr 18 17:07:01 2013 +0200
    62.3 @@ -150,9 +150,10 @@
    62.4  apply (simp_all)
    62.5  done
    62.6  
    62.7 +(* FIXME unused!? *)
    62.8  ML {*
    62.9 -val split_If_tac =
   62.10 -  simp_tac (HOL_basic_ss addsimps [@{thm If2_def} RS sym])
   62.11 +fun split_If_tac ctxt =
   62.12 +  simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm If2_def} RS sym])
   62.13      THEN' (split_tac [@{thm split_If2}])
   62.14  *}
   62.15  
    63.1 --- a/src/HOL/HOLCF/ex/Focus_ex.thy	Tue Apr 16 17:54:14 2013 +0200
    63.2 +++ b/src/HOL/HOLCF/ex/Focus_ex.thy	Thu Apr 18 17:07:01 2013 +0200
    63.3 @@ -180,7 +180,8 @@
    63.4  done
    63.5  
    63.6  lemma lemma3: "def_g(g) --> is_g(g)"
    63.7 -apply (tactic {* simp_tac (HOL_ss addsimps [@{thm def_g_def}, @{thm lemma1}, @{thm lemma2}]) 1 *})
    63.8 +apply (tactic {* simp_tac (put_simpset HOL_ss @{context}
    63.9 +  addsimps [@{thm def_g_def}, @{thm lemma1}, @{thm lemma2}]) 1 *})
   63.10  apply (rule impI)
   63.11  apply (erule exE)
   63.12  apply (rule_tac x = "f" in exI)
   63.13 @@ -204,7 +205,8 @@
   63.14  done
   63.15  
   63.16  lemma lemma4: "is_g(g) --> def_g(g)"
   63.17 -apply (tactic {* simp_tac (HOL_ss delsimps (@{thms HOL.ex_simps} @ @{thms HOL.all_simps})
   63.18 +apply (tactic {* simp_tac (put_simpset HOL_ss @{context}
   63.19 +  delsimps (@{thms HOL.ex_simps} @ @{thms HOL.all_simps})
   63.20    addsimps [@{thm lemma1}, @{thm lemma2}, @{thm def_g_def}]) 1 *})
   63.21  apply (rule impI)
   63.22  apply (erule exE)
    64.1 --- a/src/HOL/HOLCF/ex/Pattern_Match.thy	Tue Apr 16 17:54:14 2013 +0200
    64.2 +++ b/src/HOL/HOLCF/ex/Pattern_Match.thy	Thu Apr 18 17:07:01 2013 +0200
    64.3 @@ -381,7 +381,8 @@
    64.4    @{thms beta_cfun cont_id cont_const cont2cont_APP cont2cont_LAM'} @
    64.5    @{thms cont2cont_fst cont2cont_snd cont2cont_Pair};
    64.6  
    64.7 -val beta_ss = HOL_basic_ss addsimps (@{thms simp_thms} @ beta_rules);
    64.8 +val beta_ss =
    64.9 +  simpset_of (put_simpset HOL_basic_ss @{context} addsimps (@{thms simp_thms} @ beta_rules));
   64.10  
   64.11  fun define_consts
   64.12      (specs : (binding * term * mixfix) list)
   64.13 @@ -557,7 +558,7 @@
   64.14            val defs = @{thm branch_def} :: pat_defs;
   64.15            val goal = mk_trp (mk_strict fun1);
   64.16            val rules = @{thms match_bind_simps} @ case_rews;
   64.17 -          val tacs = [simp_tac (beta_ss addsimps rules) 1];
   64.18 +          val tacs = [simp_tac (Simplifier.global_context thy beta_ss addsimps rules) 1];
   64.19          in prove thy defs goal (K tacs) end;
   64.20        fun pat_apps (i, (pat, (con, args))) =
   64.21          let
   64.22 @@ -572,7 +573,7 @@
   64.23                val goal = Logic.list_implies (assms, concl);
   64.24                val defs = @{thm branch_def} :: pat_defs;
   64.25                val rules = @{thms match_bind_simps} @ case_rews;
   64.26 -              val tacs = [asm_simp_tac (beta_ss addsimps rules) 1];
   64.27 +              val tacs = [asm_simp_tac (Simplifier.global_context thy beta_ss addsimps rules) 1];
   64.28              in prove thy defs goal (K tacs) end;
   64.29          in map_index pat_app spec end;
   64.30      in
    65.1 --- a/src/HOL/Hoare/Hoare_Logic.thy	Tue Apr 16 17:54:14 2013 +0200
    65.2 +++ b/src/HOL/Hoare/Hoare_Logic.thy	Thu Apr 18 17:07:01 2013 +0200
    65.3 @@ -101,7 +101,7 @@
    65.4  
    65.5  method_setup vcg_simp = {*
    65.6    Scan.succeed (fn ctxt =>
    65.7 -    SIMPLE_METHOD' (hoare_tac ctxt (asm_full_simp_tac (simpset_of ctxt)))) *}
    65.8 +    SIMPLE_METHOD' (hoare_tac ctxt (asm_full_simp_tac ctxt))) *}
    65.9    "verification condition generator plus simplification"
   65.10  
   65.11  end
    66.1 --- a/src/HOL/Hoare/Hoare_Logic_Abort.thy	Tue Apr 16 17:54:14 2013 +0200
    66.2 +++ b/src/HOL/Hoare/Hoare_Logic_Abort.thy	Thu Apr 18 17:07:01 2013 +0200
    66.3 @@ -112,7 +112,7 @@
    66.4  
    66.5  method_setup vcg_simp = {*
    66.6    Scan.succeed (fn ctxt =>
    66.7 -    SIMPLE_METHOD' (hoare_tac ctxt (asm_full_simp_tac (simpset_of ctxt)))) *}
    66.8 +    SIMPLE_METHOD' (hoare_tac ctxt (asm_full_simp_tac ctxt))) *}
    66.9    "verification condition generator plus simplification"
   66.10  
   66.11  (* Special syntax for guarded statements and guarded array updates: *)
    67.1 --- a/src/HOL/Hoare/hoare_tac.ML	Tue Apr 16 17:54:14 2013 +0200
    67.2 +++ b/src/HOL/Hoare/hoare_tac.ML	Thu Apr 18 17:07:01 2013 +0200
    67.3 @@ -97,10 +97,11 @@
    67.4  
    67.5  (**Simp_tacs**)
    67.6  
    67.7 -val before_set2pred_simp_tac =
    67.8 -  (simp_tac (HOL_basic_ss addsimps [Collect_conj_eq RS sym, @{thm Compl_Collect}]));
    67.9 +fun before_set2pred_simp_tac ctxt =
   67.10 +  simp_tac (put_simpset HOL_basic_ss ctxt addsimps [Collect_conj_eq RS sym, @{thm Compl_Collect}]);
   67.11  
   67.12 -val split_simp_tac = (simp_tac (HOL_basic_ss addsimps [@{thm split_conv}]));
   67.13 +fun split_simp_tac ctxt =
   67.14 +  simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm split_conv}]);
   67.15  
   67.16  (*****************************************************************************)
   67.17  (** set2pred_tac transforms sets inclusion into predicates implication,     **)
   67.18 @@ -114,14 +115,15 @@
   67.19  (** simplification done by (split_all_tac)                                  **)
   67.20  (*****************************************************************************)
   67.21  
   67.22 -fun set2pred_tac var_names = SUBGOAL (fn (goal, i) =>
   67.23 -  before_set2pred_simp_tac i THEN_MAYBE
   67.24 +fun set2pred_tac ctxt var_names = SUBGOAL (fn (goal, i) =>
   67.25 +  before_set2pred_simp_tac ctxt i THEN_MAYBE
   67.26    EVERY [
   67.27      rtac subsetI i,
   67.28      rtac CollectI i,
   67.29      dtac CollectD i,
   67.30 -    TRY (split_all_tac i) THEN_MAYBE
   67.31 -     (rename_tac var_names i THEN full_simp_tac (HOL_basic_ss addsimps [@{thm split_conv}]) i)]);
   67.32 +    TRY (split_all_tac ctxt i) THEN_MAYBE
   67.33 +     (rename_tac var_names i THEN
   67.34 +      full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm split_conv}]) i)]);
   67.35  
   67.36  (*****************************************************************************)
   67.37  (** BasicSimpTac is called to simplify all verification conditions. It does **)
   67.38 @@ -131,17 +133,19 @@
   67.39  (** the tactic chosen by the user, which may solve the subgoal completely.  **)
   67.40  (*****************************************************************************)
   67.41  
   67.42 -fun MaxSimpTac var_names tac = FIRST'[rtac subset_refl, set2pred_tac var_names THEN_MAYBE' tac];
   67.43 +fun MaxSimpTac ctxt var_names tac =
   67.44 +  FIRST'[rtac subset_refl, set2pred_tac ctxt var_names THEN_MAYBE' tac];
   67.45  
   67.46 -fun BasicSimpTac var_names tac =
   67.47 +fun BasicSimpTac ctxt var_names tac =
   67.48    simp_tac
   67.49 -    (HOL_basic_ss addsimps [mem_Collect_eq, @{thm split_conv}] addsimprocs [Record.simproc])
   67.50 -  THEN_MAYBE' MaxSimpTac var_names tac;
   67.51 +    (put_simpset HOL_basic_ss ctxt
   67.52 +      addsimps [mem_Collect_eq, @{thm split_conv}] addsimprocs [Record.simproc])
   67.53 +  THEN_MAYBE' MaxSimpTac ctxt var_names tac;
   67.54  
   67.55  
   67.56  (** hoare_rule_tac **)
   67.57  
   67.58 -fun hoare_rule_tac (vars, Mlem) tac =
   67.59 +fun hoare_rule_tac ctxt (vars, Mlem) tac =
   67.60    let
   67.61      val var_names = map (fst o dest_Free) vars;
   67.62      fun wlp_tac i =
   67.63 @@ -155,16 +159,16 @@
   67.64            EVERY [
   67.65              rtac @{thm BasicRule} i,
   67.66              rtac Mlem i,
   67.67 -            split_simp_tac i],
   67.68 +            split_simp_tac ctxt i],
   67.69            EVERY [
   67.70              rtac @{thm CondRule} i,
   67.71              rule_tac false (i + 2),
   67.72              rule_tac false (i + 1)],
   67.73            EVERY [
   67.74              rtac @{thm WhileRule} i,
   67.75 -            BasicSimpTac var_names tac (i + 2),
   67.76 +            BasicSimpTac ctxt var_names tac (i + 2),
   67.77              rule_tac true (i + 1)]]
   67.78 -         THEN (if pre_cond then BasicSimpTac var_names tac i else rtac subset_refl i)));
   67.79 +         THEN (if pre_cond then BasicSimpTac ctxt var_names tac i else rtac subset_refl i)));
   67.80    in rule_tac end;
   67.81  
   67.82  
   67.83 @@ -172,5 +176,5 @@
   67.84  (** the final verification conditions                       **)
   67.85  
   67.86  fun hoare_tac ctxt (tac: int -> tactic) = SUBGOAL (fn (goal, i) =>
   67.87 -  SELECT_GOAL (hoare_rule_tac (Mset ctxt goal) tac true 1) i);
   67.88 +  SELECT_GOAL (hoare_rule_tac ctxt (Mset ctxt goal) tac true 1) i);
   67.89  
    68.1 --- a/src/HOL/Hoare_Parallel/Gar_Coll.thy	Tue Apr 16 17:54:14 2013 +0200
    68.2 +++ b/src/HOL/Hoare_Parallel/Gar_Coll.thy	Thu Apr 18 17:07:01 2013 +0200
    68.3 @@ -769,7 +769,7 @@
    68.4  apply interfree_aux
    68.5  apply(simp_all add:collector_mutator_interfree)
    68.6  apply(unfold modules collector_defs mutator_defs)
    68.7 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
    68.8 +apply(tactic  {* TRYALL (interfree_aux_tac @{context}) *})
    68.9  --{* 32 subgoals left *}
   68.10  apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
   68.11  --{* 20 subgoals left *}
   68.12 @@ -790,7 +790,7 @@
   68.13  apply interfree_aux
   68.14  apply(simp_all add:collector_mutator_interfree)
   68.15  apply(unfold modules collector_defs mutator_defs)
   68.16 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
   68.17 +apply(tactic  {* TRYALL (interfree_aux_tac @{context}) *})
   68.18  --{* 64 subgoals left *}
   68.19  apply(simp_all add:nth_list_update Invariants Append_to_free0)+
   68.20  apply(tactic{* TRYALL (clarify_tac @{context}) *})
    69.1 --- a/src/HOL/Hoare_Parallel/Mul_Gar_Coll.thy	Tue Apr 16 17:54:14 2013 +0200
    69.2 +++ b/src/HOL/Hoare_Parallel/Mul_Gar_Coll.thy	Thu Apr 18 17:07:01 2013 +0200
    69.3 @@ -131,7 +131,7 @@
    69.4  apply(interfree_aux)
    69.5  apply(simp_all add:mul_mutator_interfree)
    69.6  apply(simp_all add: mul_mutator_defs)
    69.7 -apply(tactic {* TRYALL (interfree_aux_tac) *})
    69.8 +apply(tactic {* TRYALL (interfree_aux_tac @{context}) *})
    69.9  apply(tactic {* ALLGOALS (clarify_tac @{context}) *})
   69.10  apply (simp_all add:nth_list_update)
   69.11  done
   69.12 @@ -1171,7 +1171,7 @@
   69.13  apply interfree_aux
   69.14  apply(simp_all add:mul_collector_mutator_interfree)
   69.15  apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
   69.16 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
   69.17 +apply(tactic  {* TRYALL (interfree_aux_tac @{context}) *})
   69.18  --{* 42 subgoals left *}
   69.19  apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
   69.20  --{* 24 subgoals left *}
   69.21 @@ -1201,8 +1201,8 @@
   69.22  apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac @{thm subset_psubset_trans}, etac @{thm Graph11},force_tac @{context}]) *})
   69.23  --{* 41 subgoals left *}
   69.24  apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI1, etac @{thm le_trans},
   69.25 -    force_tac (map_simpset (fn ss => ss addsimps
   69.26 -      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}]) @{context})]) *})
   69.27 +    force_tac (@{context} addsimps
   69.28 +      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
   69.29  --{* 35 subgoals left *}
   69.30  apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac @{thm psubset_subset_trans},rtac @{thm Graph9},force_tac @{context}]) *})
   69.31  --{* 31 subgoals left *}
   69.32 @@ -1211,8 +1211,8 @@
   69.33  apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac @{thm subset_psubset_trans},etac @{thm subset_psubset_trans},etac @{thm Graph11},force_tac @{context}]) *})
   69.34  --{* 25 subgoals left *}
   69.35  apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI2, rtac disjI1, etac @{thm le_trans},
   69.36 -    force_tac (map_simpset (fn ss => ss addsimps
   69.37 -      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}]) @{context})]) *})
   69.38 +    force_tac (@{context} addsimps
   69.39 +      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
   69.40  --{* 10 subgoals left *}
   69.41  apply(rule disjI2,rule disjI2,rule conjI,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update, rule disjI1, rule less_imp_le, erule less_le_trans, force simp add:Queue_def less_Suc_eq_le le_length_filter_update)+
   69.42  done
   69.43 @@ -1225,7 +1225,7 @@
   69.44  apply interfree_aux
   69.45  apply(simp_all add:mul_collector_mutator_interfree)
   69.46  apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
   69.47 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
   69.48 +apply(tactic  {* TRYALL (interfree_aux_tac @{context}) *})
   69.49  --{* 76 subgoals left *}
   69.50  apply (clarsimp simp add: nth_list_update)+
   69.51  --{* 56 subgoals left *}
    70.1 --- a/src/HOL/Hoare_Parallel/OG_Tactics.thy	Tue Apr 16 17:54:14 2013 +0200
    70.2 +++ b/src/HOL/Hoare_Parallel/OG_Tactics.thy	Thu Apr 18 17:07:01 2013 +0200
    70.3 @@ -273,11 +273,16 @@
    70.4  lemmas ParallelConseq_list = INTER_eq Collect_conj_eq length_map length_upt length_append list_length
    70.5  
    70.6  ML {*
    70.7 -val before_interfree_simp_tac = simp_tac (HOL_basic_ss addsimps [@{thm com.simps}, @{thm post.simps}])
    70.8 +fun before_interfree_simp_tac ctxt =
    70.9 +  simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm com.simps}, @{thm post.simps}])
   70.10  
   70.11 -val  interfree_simp_tac = asm_simp_tac (HOL_ss addsimps [@{thm split}, @{thm ball_Un}, @{thm ball_empty}] @ @{thms my_simp_list})
   70.12 +fun interfree_simp_tac ctxt =
   70.13 +  asm_simp_tac (put_simpset HOL_ss ctxt
   70.14 +    addsimps [@{thm split}, @{thm ball_Un}, @{thm ball_empty}] @ @{thms my_simp_list})
   70.15  
   70.16 -val ParallelConseq = simp_tac (HOL_basic_ss addsimps @{thms ParallelConseq_list} @ @{thms my_simp_list})
   70.17 +fun ParallelConseq ctxt =
   70.18 +  simp_tac (put_simpset HOL_basic_ss ctxt
   70.19 +    addsimps @{thms ParallelConseq_list} @ @{thms my_simp_list})
   70.20  *}
   70.21  
   70.22  text {* The following tactic applies @{text tac} to each conjunct in a
   70.23 @@ -320,120 +325,120 @@
   70.24  
   70.25  ML {*
   70.26  
   70.27 - fun WlpTac i = (rtac (@{thm SeqRule}) i) THEN (HoareRuleTac false (i+1))
   70.28 -and HoareRuleTac precond i st = st |>  
   70.29 -    ( (WlpTac i THEN HoareRuleTac precond i)
   70.30 +fun WlpTac ctxt i = (rtac (@{thm SeqRule}) i) THEN (HoareRuleTac ctxt false (i+1))
   70.31 +and HoareRuleTac ctxt precond i st = st |>  
   70.32 +    ( (WlpTac ctxt i THEN HoareRuleTac ctxt precond i)
   70.33        ORELSE
   70.34        (FIRST[rtac (@{thm SkipRule}) i,
   70.35               rtac (@{thm BasicRule}) i,
   70.36               EVERY[rtac (@{thm ParallelConseqRule}) i,
   70.37 -                   ParallelConseq (i+2),
   70.38 -                   ParallelTac (i+1),
   70.39 -                   ParallelConseq i], 
   70.40 +                   ParallelConseq ctxt (i+2),
   70.41 +                   ParallelTac ctxt (i+1),
   70.42 +                   ParallelConseq ctxt i], 
   70.43               EVERY[rtac (@{thm CondRule}) i,
   70.44 -                   HoareRuleTac false (i+2),
   70.45 -                   HoareRuleTac false (i+1)],
   70.46 +                   HoareRuleTac ctxt false (i+2),
   70.47 +                   HoareRuleTac ctxt false (i+1)],
   70.48               EVERY[rtac (@{thm WhileRule}) i,
   70.49 -                   HoareRuleTac true (i+1)],
   70.50 +                   HoareRuleTac ctxt true (i+1)],
   70.51               K all_tac i ]
   70.52         THEN (if precond then (K all_tac i) else (rtac (@{thm subset_refl}) i))))
   70.53  
   70.54 -and  AnnWlpTac i = (rtac (@{thm AnnSeq}) i) THEN (AnnHoareRuleTac (i+1))
   70.55 -and AnnHoareRuleTac i st = st |>  
   70.56 -    ( (AnnWlpTac i THEN AnnHoareRuleTac i )
   70.57 +and AnnWlpTac ctxt i = (rtac (@{thm AnnSeq}) i) THEN (AnnHoareRuleTac ctxt (i+1))
   70.58 +and AnnHoareRuleTac ctxt i st = st |>  
   70.59 +    ( (AnnWlpTac ctxt i THEN AnnHoareRuleTac ctxt i )
   70.60       ORELSE
   70.61        (FIRST[(rtac (@{thm AnnskipRule}) i),
   70.62               EVERY[rtac (@{thm AnnatomRule}) i,
   70.63 -                   HoareRuleTac true (i+1)],
   70.64 +                   HoareRuleTac ctxt true (i+1)],
   70.65               (rtac (@{thm AnnwaitRule}) i),
   70.66               rtac (@{thm AnnBasic}) i,
   70.67               EVERY[rtac (@{thm AnnCond1}) i,
   70.68 -                   AnnHoareRuleTac (i+3),
   70.69 -                   AnnHoareRuleTac (i+1)],
   70.70 +                   AnnHoareRuleTac ctxt (i+3),
   70.71 +                   AnnHoareRuleTac ctxt (i+1)],
   70.72               EVERY[rtac (@{thm AnnCond2}) i,
   70.73 -                   AnnHoareRuleTac (i+1)],
   70.74 +                   AnnHoareRuleTac ctxt (i+1)],
   70.75               EVERY[rtac (@{thm AnnWhile}) i,
   70.76 -                   AnnHoareRuleTac (i+2)],
   70.77 +                   AnnHoareRuleTac ctxt (i+2)],
   70.78               EVERY[rtac (@{thm AnnAwait}) i,
   70.79 -                   HoareRuleTac true (i+1)],
   70.80 +                   HoareRuleTac ctxt true (i+1)],
   70.81               K all_tac i]))
   70.82  
   70.83 -and ParallelTac i = EVERY[rtac (@{thm ParallelRule}) i,
   70.84 -                          interfree_Tac (i+1),
   70.85 -                           MapAnn_Tac i]
   70.86 +and ParallelTac ctxt i = EVERY[rtac (@{thm ParallelRule}) i,
   70.87 +                          interfree_Tac ctxt (i+1),
   70.88 +                           MapAnn_Tac ctxt i]
   70.89  
   70.90 -and MapAnn_Tac i st = st |>
   70.91 +and MapAnn_Tac ctxt i st = st |>
   70.92      (FIRST[rtac (@{thm MapAnnEmpty}) i,
   70.93             EVERY[rtac (@{thm MapAnnList}) i,
   70.94 -                 MapAnn_Tac (i+1),
   70.95 -                 AnnHoareRuleTac i],
   70.96 +                 MapAnn_Tac ctxt (i+1),
   70.97 +                 AnnHoareRuleTac ctxt i],
   70.98             EVERY[rtac (@{thm MapAnnMap}) i,
   70.99 -                 rtac (@{thm allI}) i,rtac (@{thm impI}) i,
  70.100 -                 AnnHoareRuleTac i]])
  70.101 +                 rtac (@{thm allI}) i, rtac (@{thm impI}) i,
  70.102 +                 AnnHoareRuleTac ctxt i]])
  70.103  
  70.104 -and interfree_swap_Tac i st = st |>
  70.105 +and interfree_swap_Tac ctxt i st = st |>
  70.106      (FIRST[rtac (@{thm interfree_swap_Empty}) i,
  70.107             EVERY[rtac (@{thm interfree_swap_List}) i,
  70.108 -                 interfree_swap_Tac (i+2),
  70.109 -                 interfree_aux_Tac (i+1),
  70.110 -                 interfree_aux_Tac i ],
  70.111 +                 interfree_swap_Tac ctxt (i+2),
  70.112 +                 interfree_aux_Tac ctxt (i+1),
  70.113 +                 interfree_aux_Tac ctxt i ],
  70.114             EVERY[rtac (@{thm interfree_swap_Map}) i,
  70.115                   rtac (@{thm allI}) i,rtac (@{thm impI}) i,
  70.116 -                 conjI_Tac (interfree_aux_Tac) i]])
  70.117 +                 conjI_Tac (interfree_aux_Tac ctxt) i]])
  70.118  
  70.119 -and interfree_Tac i st = st |> 
  70.120 +and interfree_Tac ctxt i st = st |> 
  70.121     (FIRST[rtac (@{thm interfree_Empty}) i,
  70.122            EVERY[rtac (@{thm interfree_List}) i,
  70.123 -                interfree_Tac (i+1),
  70.124 -                interfree_swap_Tac i],
  70.125 +                interfree_Tac ctxt (i+1),
  70.126 +                interfree_swap_Tac ctxt i],
  70.127            EVERY[rtac (@{thm interfree_Map}) i,
  70.128                  rtac (@{thm allI}) i,rtac (@{thm allI}) i,rtac (@{thm impI}) i,
  70.129 -                interfree_aux_Tac i ]])
  70.130 +                interfree_aux_Tac ctxt i ]])
  70.131  
  70.132 -and interfree_aux_Tac i = (before_interfree_simp_tac i ) THEN 
  70.133 +and interfree_aux_Tac ctxt i = (before_interfree_simp_tac ctxt i ) THEN 
  70.134          (FIRST[rtac (@{thm interfree_aux_rule1}) i,
  70.135 -               dest_assertions_Tac i])
  70.136 +               dest_assertions_Tac ctxt i])
  70.137  
  70.138 -and dest_assertions_Tac i st = st |>
  70.139 +and dest_assertions_Tac ctxt i st = st |>
  70.140      (FIRST[EVERY[rtac (@{thm AnnBasic_assertions}) i,
  70.141 -                 dest_atomics_Tac (i+1),
  70.142 -                 dest_atomics_Tac i],
  70.143 +                 dest_atomics_Tac ctxt (i+1),
  70.144 +                 dest_atomics_Tac ctxt i],
  70.145             EVERY[rtac (@{thm AnnSeq_assertions}) i,
  70.146 -                 dest_assertions_Tac (i+1),
  70.147 -                 dest_assertions_Tac i],
  70.148 +                 dest_assertions_Tac ctxt (i+1),
  70.149 +                 dest_assertions_Tac ctxt i],
  70.150             EVERY[rtac (@{thm AnnCond1_assertions}) i,
  70.151 -                 dest_assertions_Tac (i+2),
  70.152 -                 dest_assertions_Tac (i+1),
  70.153 -                 dest_atomics_Tac i],
  70.154 +                 dest_assertions_Tac ctxt (i+2),
  70.155 +                 dest_assertions_Tac ctxt (i+1),
  70.156 +                 dest_atomics_Tac ctxt i],
  70.157             EVERY[rtac (@{thm AnnCond2_assertions}) i,
  70.158 -                 dest_assertions_Tac (i+1),
  70.159 -                 dest_atomics_Tac i],
  70.160 +                 dest_assertions_Tac ctxt (i+1),
  70.161 +                 dest_atomics_Tac ctxt i],
  70.162             EVERY[rtac (@{thm AnnWhile_assertions}) i,
  70.163 -                 dest_assertions_Tac (i+2),
  70.164 -                 dest_atomics_Tac (i+1),
  70.165 -                 dest_atomics_Tac i],
  70.166 +                 dest_assertions_Tac ctxt (i+2),
  70.167 +                 dest_atomics_Tac ctxt (i+1),
  70.168 +                 dest_atomics_Tac ctxt i],
  70.169             EVERY[rtac (@{thm AnnAwait_assertions}) i,
  70.170 -                 dest_atomics_Tac (i+1),
  70.171 -                 dest_atomics_Tac i],
  70.172 -           dest_atomics_Tac i])
  70.173 +                 dest_atomics_Tac ctxt (i+1),
  70.174 +                 dest_atomics_Tac ctxt i],
  70.175 +           dest_atomics_Tac ctxt i])
  70.176  
  70.177 -and dest_atomics_Tac i st = st |>
  70.178 +and dest_atomics_Tac ctxt i st = st |>
  70.179      (FIRST[EVERY[rtac (@{thm AnnBasic_atomics}) i,
  70.180 -                 HoareRuleTac true i],
  70.181 +                 HoareRuleTac ctxt true i],
  70.182             EVERY[rtac (@{thm AnnSeq_atomics}) i,
  70.183 -                 dest_atomics_Tac (i+1),
  70.184 -                 dest_atomics_Tac i],
  70.185 +                 dest_atomics_Tac ctxt (i+1),
  70.186 +                 dest_atomics_Tac ctxt i],
  70.187             EVERY[rtac (@{thm AnnCond1_atomics}) i,
  70.188 -                 dest_atomics_Tac (i+1),
  70.189 -                 dest_atomics_Tac i],
  70.190 +                 dest_atomics_Tac ctxt (i+1),
  70.191 +                 dest_atomics_Tac ctxt i],
  70.192             EVERY[rtac (@{thm AnnCond2_atomics}) i,
  70.193 -                 dest_atomics_Tac i],
  70.194 +                 dest_atomics_Tac ctxt i],
  70.195             EVERY[rtac (@{thm AnnWhile_atomics}) i,
  70.196 -                 dest_atomics_Tac i],
  70.197 +                 dest_atomics_Tac ctxt i],
  70.198             EVERY[rtac (@{thm Annatom_atomics}) i,
  70.199 -                 HoareRuleTac true i],
  70.200 +                 HoareRuleTac ctxt true i],
  70.201             EVERY[rtac (@{thm AnnAwait_atomics}) i,
  70.202 -                 HoareRuleTac true i],
  70.203 +                 HoareRuleTac ctxt true i],
  70.204                   K all_tac i])
  70.205  *}
  70.206  
  70.207 @@ -441,8 +446,7 @@
  70.208  text {* The final tactic is given the name @{text oghoare}: *}
  70.209  
  70.210  ML {* 
  70.211 -val oghoare_tac = SUBGOAL (fn (_, i) =>
  70.212 -   (HoareRuleTac true i))
  70.213 +fun oghoare_tac ctxt = SUBGOAL (fn (_, i) => HoareRuleTac ctxt true i)
  70.214  *}
  70.215  
  70.216  text {* Notice that the tactic for parallel programs @{text
  70.217 @@ -453,26 +457,25 @@
  70.218  verification conditions for annotated sequential programs and to
  70.219  generate verification conditions out of interference freedom tests: *}
  70.220  
  70.221 -ML {* val annhoare_tac = SUBGOAL (fn (_, i) =>
  70.222 -  (AnnHoareRuleTac i))
  70.223 +ML {*
  70.224 +fun annhoare_tac ctxt = SUBGOAL (fn (_, i) => AnnHoareRuleTac ctxt i)
  70.225  
  70.226 -val interfree_aux_tac = SUBGOAL (fn (_, i) =>
  70.227 -   (interfree_aux_Tac i))
  70.228 +fun interfree_aux_tac ctxt = SUBGOAL (fn (_, i) => interfree_aux_Tac ctxt i)
  70.229  *}
  70.230  
  70.231  text {* The so defined ML tactics are then ``exported'' to be used in
  70.232  Isabelle proofs. *}
  70.233  
  70.234  method_setup oghoare = {*
  70.235 -  Scan.succeed (K (SIMPLE_METHOD' oghoare_tac)) *}
  70.236 +  Scan.succeed (SIMPLE_METHOD' o oghoare_tac) *}
  70.237    "verification condition generator for the oghoare logic"
  70.238  
  70.239  method_setup annhoare = {*
  70.240 -  Scan.succeed (K (SIMPLE_METHOD' annhoare_tac)) *}
  70.241 +  Scan.succeed (SIMPLE_METHOD' o annhoare_tac) *}
  70.242    "verification condition generator for the ann_hoare logic"
  70.243  
  70.244  method_setup interfree_aux = {*
  70.245 -  Scan.succeed (K (SIMPLE_METHOD' interfree_aux_tac)) *}
  70.246 +  Scan.succeed (SIMPLE_METHOD' o interfree_aux_tac) *}
  70.247    "verification condition generator for interference freedom tests"
  70.248  
  70.249  text {* Tactics useful for dealing with the generated verification conditions: *}
    71.1 --- a/src/HOL/IMPP/Hoare.thy	Tue Apr 16 17:54:14 2013 +0200
    71.2 +++ b/src/HOL/IMPP/Hoare.thy	Thu Apr 18 17:07:01 2013 +0200
    71.3 @@ -287,7 +287,7 @@
    71.4  apply        (blast) (* weaken *)
    71.5  apply       (tactic {* ALLGOALS (EVERY'
    71.6    [REPEAT o thin_tac @{context} "hoare_derivs ?x ?y",
    71.7 -   simp_tac @{simpset}, clarify_tac @{context}, REPEAT o smp_tac 1]) *})
    71.8 +   simp_tac @{context}, clarify_tac @{context}, REPEAT o smp_tac 1]) *})
    71.9  apply       (simp_all (no_asm_use) add: triple_valid_def2)
   71.10  apply       (intro strip, tactic "smp_tac 2 1", blast) (* conseq *)
   71.11  apply      (tactic {* ALLGOALS (clarsimp_tac @{context}) *}) (* Skip, Ass, Local *)
    72.1 --- a/src/HOL/IOA/Solve.thy	Tue Apr 16 17:54:14 2013 +0200
    72.2 +++ b/src/HOL/IOA/Solve.thy	Thu Apr 18 17:07:01 2013 +0200
    72.3 @@ -146,7 +146,7 @@
    72.4    apply (simp (no_asm) add: conj_disj_distribR cong add: conj_cong split add: split_if)
    72.5    apply (tactic {*
    72.6      REPEAT((resolve_tac [conjI,impI] 1 ORELSE etac conjE 1) THEN
    72.7 -      asm_full_simp_tac(@{simpset} addsimps [@{thm comp1_reachable}, @{thm comp2_reachable}]) 1) *})
    72.8 +      asm_full_simp_tac(@{context} addsimps [@{thm comp1_reachable}, @{thm comp2_reachable}]) 1) *})
    72.9    done
   72.10  
   72.11  
    73.1 --- a/src/HOL/Isar_Examples/Hoare.thy	Tue Apr 16 17:54:14 2013 +0200
    73.2 +++ b/src/HOL/Isar_Examples/Hoare.thy	Thu Apr 18 17:07:01 2013 +0200
    73.3 @@ -406,7 +406,8 @@
    73.4  method_setup hoare = {*
    73.5    Scan.succeed (fn ctxt =>
    73.6      (SIMPLE_METHOD'
    73.7 -       (hoare_tac ctxt (simp_tac (HOL_basic_ss addsimps [@{thm "Record.K_record_comp"}] ))))) *}
    73.8 +       (hoare_tac ctxt
    73.9 +        (simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm "Record.K_record_comp"}] ))))) *}
   73.10    "verification condition generator for Hoare logic"
   73.11  
   73.12  end
    74.1 --- a/src/HOL/Library/Extended_Nat.thy	Tue Apr 16 17:54:14 2013 +0200
    74.2 +++ b/src/HOL/Library/Extended_Nat.thy	Thu Apr 18 17:07:01 2013 +0200
    74.3 @@ -507,11 +507,12 @@
    74.4    fun dest_sum t = dest_summing (t, [])
    74.5    val find_first = find_first_t []
    74.6    val trans_tac = Numeral_Simprocs.trans_tac
    74.7 -  val norm_ss = HOL_basic_ss addsimps
    74.8 -    @{thms add_ac add_0_left add_0_right}
    74.9 -  fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
   74.10 -  fun simplify_meta_eq ss cancel_th th =
   74.11 -    Arith_Data.simplify_meta_eq [] ss
   74.12 +  val norm_ss =
   74.13 +    simpset_of (put_simpset HOL_basic_ss @{context}
   74.14 +      addsimps @{thms add_ac add_0_left add_0_right})
   74.15 +  fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
   74.16 +  fun simplify_meta_eq ctxt cancel_th th =
   74.17 +    Arith_Data.simplify_meta_eq [] ctxt
   74.18        ([th, cancel_th] MRS trans)
   74.19    fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
   74.20  end
   74.21 @@ -540,15 +541,15 @@
   74.22  
   74.23  simproc_setup enat_eq_cancel
   74.24    ("(l::enat) + m = n" | "(l::enat) = m + n") =
   74.25 -  {* fn phi => fn ss => fn ct => Eq_Enat_Cancel.proc ss (term_of ct) *}
   74.26 +  {* fn phi => fn ctxt => fn ct => Eq_Enat_Cancel.proc ctxt (term_of ct) *}
   74.27  
   74.28  simproc_setup enat_le_cancel
   74.29    ("(l::enat) + m \<le> n" | "(l::enat) \<le> m + n") =
   74.30 -  {* fn phi => fn ss => fn ct => Le_Enat_Cancel.proc ss (term_of ct) *}
   74.31 +  {* fn phi => fn ctxt => fn ct => Le_Enat_Cancel.proc ctxt (term_of ct) *}
   74.32  
   74.33  simproc_setup enat_less_cancel
   74.34    ("(l::enat) + m < n" | "(l::enat) < m + n") =
   74.35 -  {* fn phi => fn ss => fn ct => Less_Enat_Cancel.proc ss (term_of ct) *}
   74.36 +  {* fn phi => fn ctxt => fn ct => Less_Enat_Cancel.proc ctxt (term_of ct) *}
   74.37  
   74.38  text {* TODO: add regression tests for these simprocs *}
   74.39  
    75.1 --- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Tue Apr 16 17:54:14 2013 +0200
    75.2 +++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Thu Apr 18 17:07:01 2013 +0200
    75.3 @@ -723,7 +723,9 @@
    75.4     in
    75.5    (let val th = tryfind trivial_axiom (keq @ klep @ kltp)
    75.6     in
    75.7 -    (fconv_rule (arg_conv (arg1_conv real_poly_conv) then_conv Numeral_Simprocs.field_comp_conv) th, RealArith.Trivial)
    75.8 +    (fconv_rule (arg_conv (arg1_conv (real_poly_conv ctxt))
    75.9 +      then_conv Numeral_Simprocs.field_comp_conv ctxt) th,
   75.10 +      RealArith.Trivial)
   75.11     end)
   75.12     handle Failure _ =>
   75.13       (let val proof =
   75.14 @@ -820,8 +822,8 @@
   75.15     let
   75.16      val (c,v) = substitutable_monomial [] (Thm.dest_arg1(concl th))
   75.17      val th1 = Drule.arg_cong_rule (Thm.apply @{cterm "op * :: real => _"} (RealArith.cterm_of_rat (Rat.inv c))) (mk_meta_eq th)
   75.18 -    val th2 = fconv_rule (binop_conv real_poly_mul_conv) th1
   75.19 -   in fconv_rule (arg_conv real_poly_conv) (isolate_variable v th2)
   75.20 +    val th2 = fconv_rule (binop_conv (real_poly_mul_conv ctxt)) th1
   75.21 +   in fconv_rule (arg_conv (real_poly_conv ctxt)) (isolate_variable v th2)
   75.22     end
   75.23     fun oprconv cv ct =
   75.24      let val g = Thm.dest_fun2 ct
   75.25 @@ -834,7 +836,8 @@
   75.26      fun substfirst(eqs,les,lts) =
   75.27        ((let
   75.28             val eth = tryfind make_substitution eqs
   75.29 -           val modify = fconv_rule (arg_conv (oprconv(subst_conv [eth] then_conv real_poly_conv)))
   75.30 +           val modify =
   75.31 +            fconv_rule (arg_conv (oprconv(subst_conv [eth] then_conv (real_poly_conv ctxt))))
   75.32         in  substfirst
   75.33               (filter_out (fn t => (Thm.dest_arg1 o Thm.dest_arg o cprop_of) t
   75.34                                     aconvc @{cterm "0::real"}) (map modify eqs),
   75.35 @@ -922,12 +925,13 @@
   75.36     NONE => no_tac
   75.37   | SOME (d,ord) =>
   75.38       let
   75.39 -      val ss = simpset_of ctxt addsimps @{thms field_simps}
   75.40 -               addsimps [@{thm nonzero_power_divide}, @{thm power_divide}]
   75.41 +      val simp_ctxt =
   75.42 +        ctxt addsimps @{thms field_simps}
   75.43 +        addsimps [@{thm nonzero_power_divide}, @{thm power_divide}]
   75.44        val th = instantiate' [] [SOME d, SOME (Thm.dest_arg P)]
   75.45           (if ord then @{lemma "(d=0 --> P) & (d>0 --> P) & (d<(0::real) --> P) ==> P" by auto}
   75.46            else @{lemma "(d=0 --> P) & (d ~= (0::real) --> P) ==> P" by blast})
   75.47 -     in rtac th i THEN Simplifier.asm_full_simp_tac ss i end);
   75.48 +     in rtac th i THEN Simplifier.asm_full_simp_tac simp_ctxt i end);
   75.49  
   75.50  fun elim_denom_tac ctxt i = REPEAT (elim_one_denom_tac ctxt i);
   75.51  
    76.1 --- a/src/HOL/Library/positivstellensatz.ML	Tue Apr 16 17:54:14 2013 +0200
    76.2 +++ b/src/HOL/Library/positivstellensatz.ML	Thu Apr 18 17:07:01 2013 +0200
    76.3 @@ -358,15 +358,15 @@
    76.4         poly_conv,poly_neg_conv,poly_add_conv,poly_mul_conv,
    76.5         absconv1,absconv2,prover) =
    76.6    let
    76.7 -    val pre_ss = HOL_basic_ss addsimps
    76.8 +    val pre_ss = put_simpset HOL_basic_ss ctxt addsimps
    76.9        @{thms simp_thms ex_simps all_simps not_all not_ex ex_disj_distrib all_conj_distrib if_bool_eq_disj}
   76.10 -    val prenex_ss = HOL_basic_ss addsimps prenex_simps
   76.11 -    val skolemize_ss = HOL_basic_ss addsimps [choice_iff]
   76.12 -    val presimp_conv = Simplifier.rewrite (Simplifier.context ctxt pre_ss)
   76.13 -    val prenex_conv = Simplifier.rewrite (Simplifier.context ctxt prenex_ss)
   76.14 -    val skolemize_conv = Simplifier.rewrite (Simplifier.context ctxt skolemize_ss)
   76.15 -    val weak_dnf_ss = HOL_basic_ss addsimps weak_dnf_simps
   76.16 -    val weak_dnf_conv = Simplifier.rewrite (Simplifier.context ctxt weak_dnf_ss)
   76.17 +    val prenex_ss = put_simpset HOL_basic_ss ctxt addsimps prenex_simps
   76.18 +    val skolemize_ss = put_simpset HOL_basic_ss ctxt addsimps [choice_iff]
   76.19 +    val presimp_conv = Simplifier.rewrite pre_ss
   76.20 +    val prenex_conv = Simplifier.rewrite prenex_ss
   76.21 +    val skolemize_conv = Simplifier.rewrite skolemize_ss
   76.22 +    val weak_dnf_ss = put_simpset HOL_basic_ss ctxt addsimps weak_dnf_simps
   76.23 +    val weak_dnf_conv = Simplifier.rewrite weak_dnf_ss
   76.24      fun eqT_elim th = Thm.equal_elim (Thm.symmetric th) @{thm TrueI}
   76.25      fun oprconv cv ct =
   76.26        let val g = Thm.dest_fun2 ct
   76.27 @@ -423,7 +423,7 @@
   76.28        end
   76.29  
   76.30      val init_conv = presimp_conv then_conv
   76.31 -        nnf_conv then_conv skolemize_conv then_conv prenex_conv then_conv
   76.32 +        nnf_conv ctxt then_conv skolemize_conv then_conv prenex_conv then_conv
   76.33          weak_dnf_conv
   76.34  
   76.35      val concl = Thm.dest_arg o cprop_of
   76.36 @@ -540,7 +540,7 @@
   76.37      fun f ct =
   76.38        let
   76.39          val nnf_norm_conv' =
   76.40 -          nnf_conv then_conv
   76.41 +          nnf_conv ctxt then_conv
   76.42            literals_conv [@{term HOL.conj}, @{term HOL.disj}] []
   76.43            (Conv.cache_conv
   76.44              (first_conv [real_lt_conv, real_le_conv,
   76.45 @@ -701,9 +701,10 @@
   76.46  (* A less general generic arithmetic prover dealing with abs,max and min*)
   76.47  
   76.48  local
   76.49 -  val absmaxmin_elim_ss1 = HOL_basic_ss addsimps real_abs_thms1
   76.50 +  val absmaxmin_elim_ss1 =
   76.51 +    simpset_of (put_simpset HOL_basic_ss @{context} addsimps real_abs_thms1)
   76.52    fun absmaxmin_elim_conv1 ctxt =
   76.53 -    Simplifier.rewrite (Simplifier.context ctxt absmaxmin_elim_ss1)
   76.54 +    Simplifier.rewrite (put_simpset absmaxmin_elim_ss1 ctxt)
   76.55  
   76.56    val absmaxmin_elim_conv2 =
   76.57      let
   76.58 @@ -758,8 +759,11 @@
   76.59          (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"}))
   76.60          simple_cterm_ord
   76.61    in gen_real_arith ctxt
   76.62 -     (cterm_of_rat, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv,
   76.63 -      main,neg,add,mul, prover)
   76.64 +     (cterm_of_rat,
   76.65 +      Numeral_Simprocs.field_comp_conv ctxt,
   76.66 +      Numeral_Simprocs.field_comp_conv ctxt,
   76.67 +      Numeral_Simprocs.field_comp_conv ctxt,
   76.68 +      main ctxt, neg ctxt, add ctxt, mul ctxt, prover)
   76.69    end;
   76.70  
   76.71  end
    77.1 --- a/src/HOL/Library/reflection.ML	Tue Apr 16 17:54:14 2013 +0200
    77.2 +++ b/src/HOL/Library/reflection.ML	Thu Apr 18 17:07:01 2013 +0200
    77.3 @@ -275,7 +275,7 @@
    77.4      val th' = Drule.instantiate_normalize ([], cvs) th
    77.5      val t' = (fst o HOLogic.dest_eq o HOLogic.dest_Trueprop o prop_of) th'
    77.6      val th'' = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, t')))
    77.7 -               (fn _ => simp_tac (simpset_of ctxt) 1)
    77.8 +               (fn _ => simp_tac ctxt 1)
    77.9    in FWD trans [th'',th']
   77.10    end
   77.11  
   77.12 @@ -290,8 +290,9 @@
   77.13      val ft = (Thm.dest_arg1 o Thm.dest_arg o Thm.dest_arg o cprop_of) th
   77.14      val rth = conv ft
   77.15    in
   77.16 -    simplify (HOL_basic_ss addsimps raw_eqs addsimps @{thms nth_Cons_0 nth_Cons_Suc})
   77.17 -             (simplify (HOL_basic_ss addsimps [rth]) th)
   77.18 +    simplify
   77.19 +      (put_simpset HOL_basic_ss ctxt addsimps raw_eqs addsimps @{thms nth_Cons_0 nth_Cons_Suc})
   77.20 +      (simplify (put_simpset HOL_basic_ss ctxt addsimps [rth]) th)
   77.21    end
   77.22  
   77.23  fun genreify_tac ctxt eqs to = SUBGOAL (fn (goal, i) =>
    78.1 --- a/src/HOL/List.thy	Tue Apr 16 17:54:14 2013 +0200
    78.2 +++ b/src/HOL/List.thy	Thu Apr 18 17:07:01 2013 +0200
    78.3 @@ -489,7 +489,7 @@
    78.4  
    78.5  signature LIST_TO_SET_COMPREHENSION =
    78.6  sig
    78.7 -  val simproc : simpset -> cterm -> thm option
    78.8 +  val simproc : Proof.context -> cterm -> thm option
    78.9  end
   78.10  
   78.11  structure List_to_Set_Comprehension : LIST_TO_SET_COMPREHENSION =
   78.12 @@ -529,9 +529,8 @@
   78.13  
   78.14  datatype termlets = If | Case of (typ * int)
   78.15  
   78.16 -fun simproc ss redex =
   78.17 +fun simproc ctxt redex =
   78.18    let
   78.19 -    val ctxt = Simplifier.the_context ss
   78.20      val thy = Proof_Context.theory_of ctxt
   78.21      val set_Nil_I = @{thm trans} OF [@{thm set.simps(1)}, @{thm empty_def}]
   78.22      val set_singleton = @{lemma "set [a] = {x. x = a}" by simp}
   78.23 @@ -836,7 +835,9 @@
   78.24    | len (Const(@{const_name map},_) $ _ $ xs) acc = len xs acc
   78.25    | len t (ts,n) = (t::ts,n);
   78.26  
   78.27 -fun list_neq _ ss ct =
   78.28 +val ss = simpset_of @{context};
   78.29 +
   78.30 +fun list_neq ctxt ct =
   78.31    let
   78.32      val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct;
   78.33      val (ls,m) = len lhs ([],0) and (rs,n) = len rhs ([],0);
   78.34 @@ -846,15 +847,15 @@
   78.35          val size = HOLogic.size_const listT;
   78.36          val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs);
   78.37          val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len);
   78.38 -        val thm = Goal.prove (Simplifier.the_context ss) [] [] neq_len
   78.39 -          (K (simp_tac (Simplifier.inherit_context ss @{simpset}) 1));
   78.40 +        val thm = Goal.prove ctxt [] [] neq_len
   78.41 +          (K (simp_tac (put_simpset ss ctxt) 1));
   78.42        in SOME (thm RS @{thm neq_if_length_neq}) end
   78.43    in
   78.44      if m < n andalso submultiset (op aconv) (ls,rs) orelse
   78.45         n < m andalso submultiset (op aconv) (rs,ls)
   78.46      then prove_neq() else NONE
   78.47    end;
   78.48 -in list_neq end;
   78.49 +in K list_neq end;
   78.50  *}
   78.51  
   78.52  
   78.53 @@ -972,9 +973,10 @@
   78.54        | butlast xs = Const(@{const_name Nil}, fastype_of xs);
   78.55      
   78.56      val rearr_ss =
   78.57 -      HOL_basic_ss addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}];
   78.58 +      simpset_of (put_simpset HOL_basic_ss @{context}
   78.59 +        addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]);
   78.60      
   78.61 -    fun list_eq ss (F as (eq as Const(_,eqT)) $ lhs $ rhs) =
   78.62 +    fun list_eq ctxt (F as (eq as Const(_,eqT)) $ lhs $ rhs) =
   78.63        let
   78.64          val lastl = last lhs and lastr = last rhs;
   78.65          fun rearr conv =
   78.66 @@ -985,15 +987,15 @@
   78.67              val app = Const(@{const_name append},appT)
   78.68              val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr)
   78.69              val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2));
   78.70 -            val thm = Goal.prove (Simplifier.the_context ss) [] [] eq
   78.71 -              (K (simp_tac (Simplifier.inherit_context ss rearr_ss) 1));
   78.72 +            val thm = Goal.prove ctxt [] [] eq
   78.73 +              (K (simp_tac (put_simpset rearr_ss ctxt) 1));
   78.74            in SOME ((conv RS (thm RS trans)) RS eq_reflection) end;
   78.75        in
   78.76          if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv}
   78.77          else if lastl aconv lastr then rearr @{thm append_same_eq}
   78.78          else NONE
   78.79        end;
   78.80 -  in fn _ => fn ss => fn ct => list_eq ss (term_of ct) end;
   78.81 +  in fn _ => fn ctxt => fn ct => list_eq ctxt (term_of ct) end;
   78.82  *}
   78.83  
   78.84  
    79.1 --- a/src/HOL/MicroJava/J/JTypeSafe.thy	Tue Apr 16 17:54:14 2013 +0200
    79.2 +++ b/src/HOL/MicroJava/J/JTypeSafe.thy	Thu Apr 18 17:07:01 2013 +0200
    79.3 @@ -200,7 +200,7 @@
    79.4  apply( simp_all)
    79.5  apply( tactic "ALLGOALS (REPEAT o resolve_tac [impI, allI])")
    79.6  apply( tactic {* ALLGOALS (eresolve_tac [@{thm ty_expr.cases}, @{thm ty_exprs.cases}, @{thm wt_stmt.cases}]
    79.7 -                 THEN_ALL_NEW (full_simp_tac (simpset_of @{theory_context Conform}))) *})
    79.8 +  THEN_ALL_NEW (full_simp_tac (put_simpset (simpset_of @{theory_context Conform}) @{context}))) *})
    79.9  apply(tactic "ALLGOALS (EVERY' [REPEAT o (etac conjE), REPEAT o hyp_subst_tac])")
   79.10  
   79.11  -- "Level 7"
   79.12 @@ -240,11 +240,11 @@
   79.13  
   79.14  -- "for FAss"
   79.15  apply( tactic {* EVERY'[eresolve_tac [@{thm ty_expr.cases}, @{thm ty_exprs.cases}, @{thm wt_stmt.cases}] 
   79.16 -       THEN_ALL_NEW (full_simp_tac @{simpset}), REPEAT o (etac conjE), hyp_subst_tac] 3*})
   79.17 +       THEN_ALL_NEW (full_simp_tac @{context}), REPEAT o (etac conjE), hyp_subst_tac] 3*})
   79.18  
   79.19  -- "for if"
   79.20  apply( tactic {* (Induct_Tacs.case_tac @{context} "the_Bool v" THEN_ALL_NEW
   79.21 -  (asm_full_simp_tac @{simpset})) 7*})
   79.22 +  (asm_full_simp_tac @{context})) 7*})
   79.23  
   79.24  apply (tactic "forward_hyp_tac")
   79.25  
   79.26 @@ -276,7 +276,7 @@
   79.27  -- "7 LAss"
   79.28  apply (fold fun_upd_def)
   79.29  apply( tactic {* (eresolve_tac [@{thm ty_expr.cases}, @{thm ty_exprs.cases}, @{thm wt_stmt.cases}] 
   79.30 -                 THEN_ALL_NEW (full_simp_tac @{simpset})) 1 *})
   79.31 +                 THEN_ALL_NEW (full_simp_tac @{context})) 1 *})
   79.32  apply (intro strip)
   79.33  apply (case_tac E)
   79.34  apply (simp)
    80.1 --- a/src/HOL/MicroJava/J/WellForm.thy	Tue Apr 16 17:54:14 2013 +0200
    80.2 +++ b/src/HOL/MicroJava/J/WellForm.thy	Thu Apr 18 17:07:01 2013 +0200
    80.3 @@ -491,7 +491,8 @@
    80.4  apply(  rotate_tac -1, frule ssubst, erule_tac [2] asm_rl)
    80.5  prefer 2
    80.6  apply(  rotate_tac -1, frule ssubst, erule_tac [2] asm_rl)
    80.7 -apply(  tactic "asm_full_simp_tac (HOL_ss addsimps [@{thm not_None_eq} RS sym]) 1")
    80.8 +apply(  tactic "asm_full_simp_tac
    80.9 +  (put_simpset HOL_ss @{context} addsimps [@{thm not_None_eq} RS sym]) 1")
   80.10  apply(  simp_all (no_asm_simp) del: split_paired_Ex)
   80.11  apply( frule (1) class_wf)
   80.12  apply( simp (no_asm_simp) only: split_tupled_all)
    81.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Tue Apr 16 17:54:14 2013 +0200
    81.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Thu Apr 18 17:07:01 2013 +0200
    81.3 @@ -113,24 +113,27 @@
    81.4  
    81.5  method_setup vector = {*
    81.6  let
    81.7 -  val ss1 = HOL_basic_ss addsimps [@{thm setsum_addf} RS sym,
    81.8 -    @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
    81.9 -    @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym]
   81.10 -  val ss2 = @{simpset} addsimps
   81.11 +  val ss1 =
   81.12 +    simpset_of (put_simpset HOL_basic_ss @{context}
   81.13 +      addsimps [@{thm setsum_addf} RS sym,
   81.14 +      @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
   81.15 +      @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym])
   81.16 +  val ss2 =
   81.17 +    simpset_of (@{context} addsimps
   81.18               [@{thm plus_vec_def}, @{thm times_vec_def},
   81.19                @{thm minus_vec_def}, @{thm uminus_vec_def},
   81.20                @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def},
   81.21                @{thm scaleR_vec_def},
   81.22 -              @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}]
   81.23 -  fun vector_arith_tac ths =
   81.24 -    simp_tac ss1
   81.25 +              @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}])
   81.26 +  fun vector_arith_tac ctxt ths =
   81.27 +    simp_tac (put_simpset ss1 ctxt)
   81.28      THEN' (fn i => rtac @{thm setsum_cong2} i
   81.29           ORELSE rtac @{thm setsum_0'} i
   81.30 -         ORELSE simp_tac (HOL_basic_ss addsimps [@{thm vec_eq_iff}]) i)
   81.31 +         ORELSE simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm vec_eq_iff}]) i)
   81.32      (* THEN' TRY o clarify_tac HOL_cs  THEN' (TRY o rtac @{thm iffI}) *)
   81.33 -    THEN' asm_full_simp_tac (ss2 addsimps ths)
   81.34 +    THEN' asm_full_simp_tac (put_simpset ss2 ctxt addsimps ths)
   81.35  in
   81.36 -  Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths)))
   81.37 +  Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (vector_arith_tac ctxt ths))
   81.38  end
   81.39  *} "lift trivial vector statements to real arith statements"
   81.40  
    82.1 --- a/src/HOL/Multivariate_Analysis/normarith.ML	Tue Apr 16 17:54:14 2013 +0200
    82.2 +++ b/src/HOL/Multivariate_Analysis/normarith.ML	Thu Apr 18 17:07:01 2013 +0200
    82.3 @@ -165,7 +165,9 @@
    82.4    val real_poly_conv =
    82.5      Semiring_Normalizer.semiring_normalize_wrapper ctxt
    82.6       (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"}))
    82.7 - in fconv_rule (arg_conv ((rewr_conv @{thm ge_iff_diff_ge_0}) then_conv arg_conv (Numeral_Simprocs.field_comp_conv then_conv real_poly_conv)))
    82.8 + in
    82.9 +  fconv_rule (arg_conv ((rewr_conv @{thm ge_iff_diff_ge_0}) then_conv
   82.10 +    arg_conv (Numeral_Simprocs.field_comp_conv ctxt then_conv real_poly_conv)))
   82.11  end;
   82.12  
   82.13   val apply_pth1 = rewr_conv @{thm pth_1};
   82.14 @@ -175,8 +177,13 @@
   82.15   val apply_pth5 = rewr_conv @{thm pth_5};
   82.16   val apply_pth6 = rewr_conv @{thm pth_6};
   82.17   val apply_pth7 = rewrs_conv @{thms pth_7};
   82.18 - val apply_pth8 = rewr_conv @{thm pth_8} then_conv arg1_conv Numeral_Simprocs.field_comp_conv then_conv (try_conv (rewr_conv (mk_meta_eq @{thm scaleR_zero_left})));
   82.19 - val apply_pth9 = rewrs_conv @{thms pth_9} then_conv arg1_conv (arg1_conv Numeral_Simprocs.field_comp_conv);
   82.20 + fun apply_pth8 ctxt =
   82.21 +  rewr_conv @{thm pth_8} then_conv
   82.22 +  arg1_conv (Numeral_Simprocs.field_comp_conv ctxt) then_conv
   82.23 +  (try_conv (rewr_conv (mk_meta_eq @{thm scaleR_zero_left})));
   82.24 + fun apply_pth9 ctxt =
   82.25 +  rewrs_conv @{thms pth_9} then_conv
   82.26 +  arg1_conv (arg1_conv (Numeral_Simprocs.field_comp_conv ctxt));
   82.27   val apply_ptha = rewr_conv @{thm pth_a};
   82.28   val apply_pthb = rewrs_conv @{thms pth_b};
   82.29   val apply_pthc = rewrs_conv @{thms pth_c};
   82.30 @@ -188,13 +195,13 @@
   82.31   | Const(@{const_name scaleR}, _)$_$v => v
   82.32   | _ => error "headvector: non-canonical term"
   82.33  
   82.34 -fun vector_cmul_conv ct =
   82.35 -   ((apply_pth5 then_conv arg1_conv Numeral_Simprocs.field_comp_conv) else_conv
   82.36 -    (apply_pth6 then_conv binop_conv vector_cmul_conv)) ct
   82.37 +fun vector_cmul_conv ctxt ct =
   82.38 +   ((apply_pth5 then_conv arg1_conv (Numeral_Simprocs.field_comp_conv ctxt)) else_conv
   82.39 +    (apply_pth6 then_conv binop_conv (vector_cmul_conv ctxt))) ct
   82.40  
   82.41 -fun vector_add_conv ct = apply_pth7 ct
   82.42 +fun vector_add_conv ctxt ct = apply_pth7 ct
   82.43   handle CTERM _ =>
   82.44 -  (apply_pth8 ct
   82.45 +  (apply_pth8 ctxt ct
   82.46     handle CTERM _ =>
   82.47      (case term_of ct of
   82.48       Const(@{const_name plus},_)$lt$rt =>
   82.49 @@ -202,35 +209,35 @@
   82.50         val l = headvector lt
   82.51         val r = headvector rt
   82.52        in (case Term_Ord.fast_term_ord (l,r) of
   82.53 -         LESS => (apply_pthb then_conv arg_conv vector_add_conv
   82.54 +         LESS => (apply_pthb then_conv arg_conv (vector_add_conv ctxt)
   82.55                    then_conv apply_pthd) ct
   82.56 -        | GREATER => (apply_pthc then_conv arg_conv vector_add_conv
   82.57 +        | GREATER => (apply_pthc then_conv arg_conv (vector_add_conv ctxt)
   82.58                       then_conv apply_pthd) ct
   82.59 -        | EQUAL => (apply_pth9 then_conv
   82.60 -                ((apply_ptha then_conv vector_add_conv) else_conv
   82.61 -              arg_conv vector_add_conv then_conv apply_pthd)) ct)
   82.62 +        | EQUAL => (apply_pth9 ctxt then_conv
   82.63 +                ((apply_ptha then_conv (vector_add_conv ctxt)) else_conv
   82.64 +              arg_conv (vector_add_conv ctxt) then_conv apply_pthd)) ct)
   82.65        end
   82.66       | _ => Thm.reflexive ct))
   82.67  
   82.68 -fun vector_canon_conv ct = case term_of ct of
   82.69 +fun vector_canon_conv ctxt ct = case term_of ct of
   82.70   Const(@{const_name plus},_)$_$_ =>
   82.71    let
   82.72     val ((p,l),r) = Thm.dest_comb ct |>> Thm.dest_comb
   82.73 -   val lth = vector_canon_conv l
   82.74 -   val rth = vector_canon_conv r
   82.75 +   val lth = vector_canon_conv ctxt l
   82.76 +   val rth = vector_canon_conv ctxt r
   82.77     val th = Drule.binop_cong_rule p lth rth
   82.78 -  in fconv_rule (arg_conv vector_add_conv) th end
   82.79 +  in fconv_rule (arg_conv (vector_add_conv ctxt)) th end
   82.80  
   82.81  | Const(@{const_name scaleR}, _)$_$_ =>
   82.82    let
   82.83     val (p,r) = Thm.dest_comb ct
   82.84 -   val rth = Drule.arg_cong_rule p (vector_canon_conv r)
   82.85 -  in fconv_rule (arg_conv (apply_pth4 else_conv vector_cmul_conv)) rth
   82.86 +   val rth = Drule.arg_cong_rule p (vector_canon_conv ctxt r)
   82.87 +  in fconv_rule (arg_conv (apply_pth4 else_conv (vector_cmul_conv ctxt))) rth
   82.88    end
   82.89  
   82.90 -| Const(@{const_name minus},_)$_$_ => (apply_pth2 then_conv vector_canon_conv) ct
   82.91 +| Const(@{const_name minus},_)$_$_ => (apply_pth2 then_conv (vector_canon_conv ctxt)) ct
   82.92  
   82.93 -| Const(@{const_name uminus},_)$_ => (apply_pth3 then_conv vector_canon_conv) ct
   82.94 +| Const(@{const_name uminus},_)$_ => (apply_pth3 then_conv (vector_canon_conv ctxt)) ct
   82.95  
   82.96  (* FIXME
   82.97  | Const(@{const_name vec},_)$n =>
   82.98 @@ -241,8 +248,8 @@
   82.99  *)
  82.100  | _ => apply_pth1 ct
  82.101  
  82.102 -fun norm_canon_conv ct = case term_of ct of
  82.103 -  Const(@{const_name norm},_)$_ => arg_conv vector_canon_conv ct
  82.104 +fun norm_canon_conv ctxt ct = case term_of ct of
  82.105 +  Const(@{const_name norm},_)$_ => arg_conv (vector_canon_conv ctxt) ct
  82.106   | _ => raise CTERM ("norm_canon_conv", [ct])
  82.107  
  82.108  fun int_flip v eq =
  82.109 @@ -314,9 +321,9 @@
  82.110    in fst (RealArith.real_linear_prover translator
  82.111          (map (fn t => Drule.instantiate_normalize ([(tv_n, ctyp_of_term t)],[]) pth_zero)
  82.112              zerodests,
  82.113 -        map (fconv_rule (try_conv (Conv.top_sweep_conv (K norm_canon_conv) ctxt) then_conv
  82.114 +        map (fconv_rule (try_conv (Conv.top_sweep_conv (K (norm_canon_conv ctxt)) ctxt) then_conv
  82.115                         arg_conv (arg_conv real_poly_conv))) ges',
  82.116 -        map (fconv_rule (try_conv (Conv.top_sweep_conv (K norm_canon_conv) ctxt) then_conv
  82.117 +        map (fconv_rule (try_conv (Conv.top_sweep_conv (K (norm_canon_conv ctxt)) ctxt) then_conv
  82.118                         arg_conv (arg_conv real_poly_conv))) gts))
  82.119    end
  82.120  in val real_vector_combo_prover = real_vector_combo_prover
  82.121 @@ -367,7 +374,7 @@
  82.122         (Semiring_Normalizer.semiring_normalizers_ord_wrapper ctxt
  82.123          (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"})) simple_cterm_ord)
  82.124     val (th1,th2) = conj_pair(rawrule th)
  82.125 -  in th1::fconv_rule (arg_conv (arg_conv real_poly_neg_conv)) th2::acc
  82.126 +  in th1::fconv_rule (arg_conv (arg_conv (real_poly_neg_conv ctxt))) th2::acc
  82.127    end
  82.128  in fun real_vector_prover ctxt _ translator (eqs,ges,gts) =
  82.129       (real_vector_ineq_prover ctxt translator
  82.130 @@ -375,10 +382,11 @@
  82.131  end;
  82.132  
  82.133    fun init_conv ctxt =
  82.134 -   Simplifier.rewrite (Simplifier.context ctxt
  82.135 -     (HOL_basic_ss addsimps ([(*@{thm vec_0}, @{thm vec_1},*) @{thm dist_norm}, @{thm right_minus}, @{thm diff_self}, @{thm norm_zero}] @ @{thms arithmetic_simps} @ @{thms norm_pths})))
  82.136 -   then_conv Numeral_Simprocs.field_comp_conv
  82.137 -   then_conv nnf_conv
  82.138 +   Simplifier.rewrite (put_simpset HOL_basic_ss ctxt
  82.139 +    addsimps ([(*@{thm vec_0}, @{thm vec_1},*) @{thm dist_norm}, @{thm right_minus},
  82.140 +      @{thm diff_self}, @{thm norm_zero}] @ @{thms arithmetic_simps} @ @{thms norm_pths}))
  82.141 +   then_conv Numeral_Simprocs.field_comp_conv ctxt
  82.142 +   then_conv nnf_conv ctxt
  82.143  
  82.144   fun pure ctxt = fst o RealArith.gen_prover_real_arith ctxt (real_vector_prover ctxt);
  82.145   fun norm_arith ctxt ct =
    83.1 --- a/src/HOL/NanoJava/Equivalence.thy	Tue Apr 16 17:54:14 2013 +0200
    83.2 +++ b/src/HOL/NanoJava/Equivalence.thy	Thu Apr 18 17:07:01 2013 +0200
    83.3 @@ -101,7 +101,7 @@
    83.4  by(simp add: cnvalids_def nvalids_def nvalid_def2)
    83.5  
    83.6  lemma hoare_sound_main:"\<And>t. (A |\<turnstile> C \<longrightarrow> A |\<Turnstile> C) \<and> (A |\<turnstile>\<^sub>e t \<longrightarrow> A |\<Turnstile>\<^sub>e t)"
    83.7 -apply (tactic "split_all_tac 1", rename_tac P e Q)
    83.8 +apply (tactic "split_all_tac @{context} 1", rename_tac P e Q)
    83.9  apply (rule hoare_ehoare.induct)
   83.10  (*18*)
   83.11  apply (tactic {* ALLGOALS (REPEAT o dresolve_tac [@{thm all_conjunct2}, @{thm all3_conjunct2}]) *})
    84.1 --- a/src/HOL/Nominal/nominal_atoms.ML	Tue Apr 16 17:54:14 2013 +0200
    84.2 +++ b/src/HOL/Nominal/nominal_atoms.ML	Thu Apr 18 17:07:01 2013 +0200
    84.3 @@ -116,23 +116,23 @@
    84.4  
    84.5                val simp1 = @{thm inj_on_def} :: injects;
    84.6                
    84.7 -              val proof1 = fn _ => EVERY [simp_tac (HOL_basic_ss addsimps simp1) 1,
    84.8 +              fun proof1 ctxt = EVERY [simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp1) 1,
    84.9                                            rtac @{thm ballI} 1,
   84.10                                            rtac @{thm ballI} 1,
   84.11                                            rtac @{thm impI} 1,
   84.12                                            atac 1]
   84.13               
   84.14                val (inj_thm,thy2) = 
   84.15 -                   add_thms_string [((ak^"_inj",Goal.prove_global thy1 [] [] stmnt1 proof1), [])] thy1
   84.16 +                   add_thms_string [((ak^"_inj",Goal.prove_global thy1 [] [] stmnt1 (proof1 o #context)), [])] thy1
   84.17                
   84.18                (* second statement *)
   84.19                val y = Free ("y",ak_type)  
   84.20                val stmnt2 = HOLogic.mk_Trueprop
   84.21                    (HOLogic.mk_exists ("x",@{typ nat},HOLogic.mk_eq (y,Const (ak_sign,inj_type) $ Bound 0)))
   84.22  
   84.23 -              val proof2 = fn {prems, context} =>
   84.24 -                Induct_Tacs.case_tac context "y" 1 THEN
   84.25 -                asm_simp_tac (HOL_basic_ss addsimps simp1) 1 THEN
   84.26 +              val proof2 = fn {prems, context = ctxt} =>
   84.27 +                Induct_Tacs.case_tac ctxt "y" 1 THEN
   84.28 +                asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp1) 1 THEN
   84.29                  rtac @{thm exI} 1 THEN
   84.30                  rtac @{thm refl} 1
   84.31  
   84.32 @@ -148,13 +148,13 @@
   84.33                val simp2 = [@{thm image_def},@{thm bex_UNIV}]@inject_thm
   84.34                val simp3 = [@{thm UNIV_def}]
   84.35  
   84.36 -              val proof3 = fn _ => EVERY [cut_facts_tac inj_thm 1,
   84.37 +              fun proof3 ctxt = EVERY [cut_facts_tac inj_thm 1,
   84.38                                            dtac @{thm range_inj_infinite} 1,
   84.39 -                                          asm_full_simp_tac (HOL_basic_ss addsimps simp2) 1,
   84.40 -                                          simp_tac (HOL_basic_ss addsimps simp3) 1]  
   84.41 +                                          asm_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp2) 1,
   84.42 +                                          simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp3) 1]
   84.43             
   84.44                val (inf_thm,thy4) =  
   84.45 -                    add_thms_string [((ak^"_infinite",Goal.prove_global thy3 [] [] stmnt3 proof3), [])] thy3
   84.46 +                    add_thms_string [((ak^"_infinite",Goal.prove_global thy3 [] [] stmnt3 (proof3 o #context)), [])] thy3
   84.47            in 
   84.48              ((inj_thm,inject_thm,inf_thm),thy4)
   84.49            end) ak_names thy
   84.50 @@ -267,21 +267,19 @@
   84.51          val i_type = Type(ak_name_qu,[]);
   84.52          val cat = Const ("Nominal.at",(Term.itselfT i_type)  --> HOLogic.boolT);
   84.53          val at_type = Logic.mk_type i_type;
   84.54 -        val simp_s = HOL_ss addsimps maps (Global_Theory.get_thms thy5)
   84.55 +        fun proof ctxt =
   84.56 +          simp_tac (put_simpset HOL_ss ctxt
   84.57 +            addsimps maps (Global_Theory.get_thms thy5)
   84.58                                    ["at_def",
   84.59                                     ak_name ^ "_prm_" ^ ak_name ^ "_def",
   84.60                                     ak_name ^ "_prm_" ^ ak_name ^ ".simps",
   84.61                                     "swap_" ^ ak_name ^ "_def",
   84.62                                     "swap_" ^ ak_name ^ ".simps",
   84.63 -                                   ak_name ^ "_infinite"]
   84.64 -            
   84.65 +                                   ak_name ^ "_infinite"]) 1;            
   84.66          val name = "at_"^ak_name^ "_inst";
   84.67          val statement = HOLogic.mk_Trueprop (cat $ at_type);
   84.68 -
   84.69 -        val proof = fn _ => simp_tac simp_s 1
   84.70 -
   84.71        in 
   84.72 -        ((name, Goal.prove_global thy5 [] [] statement proof), []) 
   84.73 +        ((name, Goal.prove_global thy5 [] [] statement (proof o #context)), [])
   84.74        end) ak_names_types);
   84.75  
   84.76      (* declares a perm-axclass for every atom-kind               *)
   84.77 @@ -331,18 +329,17 @@
   84.78          val cpt = Const ("Nominal.pt",(Term.itselfT i_type1)-->(Term.itselfT i_type2)-->HOLogic.boolT);
   84.79          val pt_type = Logic.mk_type i_type1;
   84.80          val at_type = Logic.mk_type i_type2;
   84.81 -        val simp_s = HOL_ss addsimps maps (Global_Theory.get_thms thy7)
   84.82 +        fun proof ctxt =
   84.83 +          simp_tac (put_simpset HOL_ss ctxt addsimps maps (Global_Theory.get_thms thy7)
   84.84                                    ["pt_def",
   84.85                                     "pt_" ^ ak_name ^ "1",
   84.86                                     "pt_" ^ ak_name ^ "2",
   84.87 -                                   "pt_" ^ ak_name ^ "3"];
   84.88 +                                   "pt_" ^ ak_name ^ "3"]) 1;
   84.89  
   84.90          val name = "pt_"^ak_name^ "_inst";
   84.91          val statement = HOLogic.mk_Trueprop (cpt $ pt_type $ at_type);
   84.92 -
   84.93 -        val proof = fn _ => simp_tac simp_s 1;
   84.94        in 
   84.95 -        ((name, Goal.prove_global thy7 [] [] statement proof), []) 
   84.96 +        ((name, Goal.prove_global thy7 [] [] statement (proof o #context)), []) 
   84.97        end) ak_names_types);
   84.98  
   84.99       (* declares an fs-axclass for every atom-kind       *)
  84.100 @@ -379,16 +376,15 @@
  84.101                                   (Term.itselfT i_type1)-->(Term.itselfT i_type2)-->HOLogic.boolT);
  84.102           val fs_type = Logic.mk_type i_type1;
  84.103           val at_type = Logic.mk_type i_type2;
  84.104 -         val simp_s = HOL_ss addsimps maps (Global_Theory.get_thms thy11)
  84.105 +         fun proof ctxt =
  84.106 +          simp_tac (put_simpset HOL_ss ctxt addsimps maps (Global_Theory.get_thms thy11)
  84.107                                     ["fs_def",
  84.108 -                                    "fs_" ^ ak_name ^ "1"];
  84.109 +                                    "fs_" ^ ak_name ^ "1"]) 1;
  84.110      
  84.111           val name = "fs_"^ak_name^ "_inst";
  84.112           val statement = HOLogic.mk_Trueprop (cfs $ fs_type $ at_type);
  84.113 -
  84.114 -         val proof = fn _ => simp_tac simp_s 1;
  84.115         in 
  84.116 -         ((name, Goal.prove_global thy11 [] [] statement proof), []) 
  84.117 +         ((name, Goal.prove_global thy11 [] [] statement (proof o #context)), []) 
  84.118         end) ak_names_types);
  84.119  
  84.120         (* declares for every atom-kind combination an axclass            *)
  84.121 @@ -432,18 +428,18 @@
  84.122               val at_type  = Logic.mk_type i_type1;
  84.123               val at_type' = Logic.mk_type i_type2;
  84.124               val cp_type  = Logic.mk_type i_type0;
  84.125 -             val simp_s   = HOL_basic_ss addsimps maps (Global_Theory.get_thms thy') ["cp_def"];
  84.126               val cp1      = Global_Theory.get_thm thy' ("cp_" ^ ak_name ^ "_" ^ ak_name' ^ "1");
  84.127  
  84.128               val name = "cp_"^ak_name^ "_"^ak_name'^"_inst";
  84.129               val statement = HOLogic.mk_Trueprop (ccp $ cp_type $ at_type $ at_type');
  84.130  
  84.131 -             val proof = fn _ => EVERY [simp_tac simp_s 1, 
  84.132 -                                        rtac allI 1, rtac allI 1, rtac allI 1,
  84.133 -                                        rtac cp1 1];
  84.134 +             fun proof ctxt =
  84.135 +              simp_tac (put_simpset HOL_basic_ss ctxt
  84.136 +                  addsimps maps (Global_Theory.get_thms thy') ["cp_def"]) 1
  84.137 +                THEN EVERY [rtac allI 1, rtac allI 1, rtac allI 1, rtac cp1 1];
  84.138             in
  84.139               yield_singleton add_thms_string ((name,
  84.140 -               Goal.prove_global thy' [] [] statement proof), []) thy'
  84.141 +               Goal.prove_global thy' [] [] statement (proof o #context)), []) thy'
  84.142             end) 
  84.143             ak_names_types thy) ak_names_types thy12b;
  84.144         
  84.145 @@ -464,17 +460,17 @@
  84.146                             (Term.itselfT i_type1)-->(Term.itselfT i_type2)-->HOLogic.boolT);
  84.147                   val at_type  = Logic.mk_type i_type1;
  84.148                   val at_type' = Logic.mk_type i_type2;
  84.149 -                 val simp_s = HOL_ss addsimps maps (Global_Theory.get_thms thy')
  84.150 +                 fun proof ctxt =
  84.151 +                  simp_tac (put_simpset HOL_ss ctxt
  84.152 +                    addsimps maps (Global_Theory.get_thms thy')
  84.153                                             ["disjoint_def",
  84.154                                              ak_name ^ "_prm_" ^ ak_name' ^ "_def",
  84.155 -                                            ak_name' ^ "_prm_" ^ ak_name ^ "_def"];
  84.156 +                                            ak_name' ^ "_prm_" ^ ak_name ^ "_def"]) 1;
  84.157  
  84.158                   val name = "dj_"^ak_name^"_"^ak_name';
  84.159                   val statement = HOLogic.mk_Trueprop (cdj $ at_type $ at_type');
  84.160 -
  84.161 -                 val proof = fn _ => simp_tac simp_s 1;
  84.162                 in
  84.163 -                add_thms_string [((name, Goal.prove_global thy' [] [] statement proof), [])] thy'
  84.164 +                add_thms_string [((name, Goal.prove_global thy' [] [] statement (proof o #context)), [])] thy'
  84.165                 end
  84.166             else 
  84.167              ([],thy')))  (* do nothing branch, if ak_name = ak_name' *) 
  84.168 @@ -511,14 +507,15 @@
  84.169                                   rtac ((at_inst RS at_pt_inst) RS pt2) 1,
  84.170                                   rtac ((at_inst RS at_pt_inst) RS pt3) 1,
  84.171                                   atac 1];
  84.172 -           val simp_s = HOL_basic_ss addsimps 
  84.173 -                        maps (Global_Theory.get_thms thy') [ak_name ^ "_prm_" ^ ak_name' ^ "_def"];  
  84.174 -           val proof2 = EVERY [Class.intro_classes_tac [], REPEAT (asm_simp_tac simp_s 1)];
  84.175 -
  84.176 +           fun proof2 ctxt =
  84.177 +             Class.intro_classes_tac [] THEN
  84.178 +             REPEAT (asm_simp_tac
  84.179 +              (put_simpset HOL_basic_ss ctxt addsimps
  84.180 +                maps (Global_Theory.get_thms thy') [ak_name ^ "_prm_" ^ ak_name' ^ "_def"]) 1);
  84.181           in
  84.182             thy'
  84.183             |> Axclass.prove_arity (qu_name,[],[cls_name])
  84.184 -              (fn _ => if ak_name = ak_name' then proof1 else proof2)
  84.185 +              (fn ctxt => if ak_name = ak_name' then proof1 else proof2 ctxt)
  84.186           end) ak_names thy) ak_names thy12d;
  84.187  
  84.188       (* show that                       *)
  84.189 @@ -581,7 +578,7 @@
  84.190          let
  84.191             val qu_name =  Sign.full_bname thy' ak_name';
  84.192             val qu_class = Sign.full_bname thy' ("fs_"^ak_name);
  84.193 -           val proof =
  84.194 +           fun proof ctxt =
  84.195                 (if ak_name = ak_name'
  84.196                  then
  84.197                    let val at_thm = Global_Theory.get_thm thy' ("at_"^ak_name^"_inst");
  84.198 @@ -589,10 +586,11 @@
  84.199                               rtac ((at_thm RS fs_at_inst) RS fs1) 1] end
  84.200                  else
  84.201                    let val dj_inst = Global_Theory.get_thm thy' ("dj_"^ak_name'^"_"^ak_name);
  84.202 -                      val simp_s = HOL_basic_ss addsimps [dj_inst RS dj_supp, finite_emptyI];
  84.203 +                      val simp_s =
  84.204 +                        put_simpset HOL_basic_ss ctxt addsimps [dj_inst RS dj_supp, finite_emptyI];
  84.205                    in EVERY [Class.intro_classes_tac [], asm_simp_tac simp_s 1] end)
  84.206          in
  84.207 -         Axclass.prove_arity (qu_name,[],[qu_class]) (fn _ => proof) thy'
  84.208 +         Axclass.prove_arity (qu_name,[],[qu_class]) proof thy'
  84.209          end) ak_names thy) ak_names thy18;
  84.210  
  84.211         (* shows that                  *)
  84.212 @@ -648,7 +646,7 @@
  84.213              let
  84.214                val name =  Sign.full_bname thy'' ak_name;
  84.215                val cls_name = Sign.full_bname thy'' ("cp_"^ak_name'^"_"^ak_name'');
  84.216 -              val proof =
  84.217 +              fun proof ctxt =
  84.218                  (if (ak_name'=ak_name'') then 
  84.219                    (let
  84.220                      val pt_inst  = Global_Theory.get_thm thy'' ("pt_"^ak_name''^"_inst");
  84.221 @@ -660,7 +658,7 @@
  84.222                  else
  84.223                    (let
  84.224                       val dj_inst  = Global_Theory.get_thm thy'' ("dj_"^ak_name''^"_"^ak_name');
  84.225 -                     val simp_s = HOL_basic_ss addsimps
  84.226 +                     val simp_s = put_simpset HOL_basic_ss ctxt addsimps
  84.227                                          ((dj_inst RS dj_pp_forget)::
  84.228                                           (maps (Global_Theory.get_thms thy'')
  84.229                                             [ak_name' ^"_prm_"^ak_name^"_def",
  84.230 @@ -669,7 +667,7 @@
  84.231                      EVERY [Class.intro_classes_tac [], simp_tac simp_s 1]
  84.232                    end))
  84.233                in
  84.234 -                Axclass.prove_arity (name,[],[cls_name]) (fn _ => proof) thy''
  84.235 +                Axclass.prove_arity (name,[],[cls_name]) proof thy''
  84.236                end) ak_names thy') ak_names thy) ak_names thy24;
  84.237  
  84.238         (* shows that                                                    *) 
  84.239 @@ -719,10 +717,11 @@
  84.240               fold (fn ak_name => fn thy =>
  84.241               let
  84.242                 val qu_class = Sign.full_bname thy ("pt_"^ak_name);
  84.243 -               val simp_s = HOL_basic_ss addsimps [Simpdata.mk_eq defn];
  84.244 -               val proof = EVERY [Class.intro_classes_tac [], REPEAT (asm_simp_tac simp_s 1)];
  84.245 +               fun proof ctxt =
  84.246 +                Class.intro_classes_tac [] THEN
  84.247 +                REPEAT (asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [Simpdata.mk_eq defn]) 1);
  84.248               in 
  84.249 -               Axclass.prove_arity (discrete_ty, [], [qu_class]) (fn _ => proof) thy
  84.250 +               Axclass.prove_arity (discrete_ty, [], [qu_class]) proof thy
  84.251               end) ak_names;
  84.252  
  84.253            fun discrete_fs_inst discrete_ty defn = 
  84.254 @@ -730,10 +729,12 @@
  84.255               let
  84.256                 val qu_class = Sign.full_bname thy ("fs_"^ak_name);
  84.257                 val supp_def = Simpdata.mk_eq @{thm "Nominal.supp_def"};
  84.258 -               val simp_s = HOL_ss addsimps [supp_def, Collect_const, finite_emptyI, Simpdata.mk_eq defn];
  84.259 -               val proof = EVERY [Class.intro_classes_tac [], asm_simp_tac simp_s 1];
  84.260 +               fun proof ctxt =
  84.261 +                Class.intro_classes_tac [] THEN
  84.262 +                asm_simp_tac (put_simpset HOL_ss ctxt
  84.263 +                  addsimps [supp_def, Collect_const, finite_emptyI, Simpdata.mk_eq defn]) 1;
  84.264               in 
  84.265 -               Axclass.prove_arity (discrete_ty, [], [qu_class]) (fn _ => proof) thy
  84.266 +               Axclass.prove_arity (discrete_ty, [], [qu_class]) proof thy
  84.267               end) ak_names;
  84.268  
  84.269            fun discrete_cp_inst discrete_ty defn = 
  84.270 @@ -741,10 +742,11 @@
  84.271               let
  84.272                 val qu_class = Sign.full_bname thy ("cp_"^ak_name^"_"^ak_name');
  84.273                 val supp_def = Simpdata.mk_eq @{thm "Nominal.supp_def"};
  84.274 -               val simp_s = HOL_ss addsimps [Simpdata.mk_eq defn];
  84.275 -               val proof = EVERY [Class.intro_classes_tac [], asm_simp_tac simp_s 1];
  84.276 +               fun proof ctxt =
  84.277 +                Class.intro_classes_tac [] THEN
  84.278 +                asm_simp_tac (put_simpset HOL_ss ctxt addsimps [Simpdata.mk_eq defn]) 1;
  84.279               in
  84.280 -               Axclass.prove_arity (discrete_ty, [], [qu_class]) (fn _ => proof) thy
  84.281 +               Axclass.prove_arity (discrete_ty, [], [qu_class]) proof thy
  84.282               end) ak_names)) ak_names;
  84.283  
  84.284          in
    85.1 --- a/src/HOL/Nominal/nominal_datatype.ML	Tue Apr 16 17:54:14 2013 +0200
    85.2 +++ b/src/HOL/Nominal/nominal_datatype.ML	Thu Apr 18 17:07:01 2013 +0200
    85.3 @@ -96,10 +96,11 @@
    85.4  fun permTs_of (Const ("Nominal.perm", T) $ t $ u) = fst (dest_permT T) :: permTs_of u
    85.5    | permTs_of _ = [];
    85.6  
    85.7 -fun perm_simproc' thy ss (Const ("Nominal.perm", T) $ t $ (u as Const ("Nominal.perm", U) $ r $ s)) =
    85.8 +fun perm_simproc' ctxt (Const ("Nominal.perm", T) $ t $ (u as Const ("Nominal.perm", U) $ r $ s)) =
    85.9        let
   85.10 +        val thy = Proof_Context.theory_of ctxt;
   85.11          val (aT as Type (a, []), S) = dest_permT T;
   85.12 -        val (bT as Type (b, []), _) = dest_permT U
   85.13 +        val (bT as Type (b, []), _) = dest_permT U;
   85.14        in if member (op =) (permTs_of u) aT andalso aT <> bT then
   85.15            let
   85.16              val cp = cp_inst_of thy a b;
   85.17 @@ -112,7 +113,7 @@
   85.18            end
   85.19          else NONE
   85.20        end
   85.21 -  | perm_simproc' thy ss _ = NONE;
   85.22 +  | perm_simproc' _ _ = NONE;
   85.23  
   85.24  val perm_simproc =
   85.25    Simplifier.simproc_global @{theory} "perm_simp" ["pi1 \<bullet> (pi2 \<bullet> x)"] perm_simproc';
   85.26 @@ -279,8 +280,7 @@
   85.27                 end)
   85.28               (perm_names_types ~~ perm_indnames))))
   85.29            (fn {context = ctxt, ...} => EVERY [Datatype_Aux.ind_tac induct perm_indnames 1,
   85.30 -            ALLGOALS (asm_full_simp_tac
   85.31 -              (simpset_of ctxt addsimps [perm_fun_def]))])),
   85.32 +            ALLGOALS (asm_full_simp_tac (ctxt addsimps [perm_fun_def]))])),
   85.33          length new_type_names));
   85.34  
   85.35      (**** prove [] \<bullet> t = t ****)
   85.36 @@ -300,7 +300,7 @@
   85.37                 (perm_names ~~
   85.38                  map body_type perm_types ~~ perm_indnames)))))
   85.39            (fn {context = ctxt, ...} => EVERY [Datatype_Aux.ind_tac induct perm_indnames 1,
   85.40 -            ALLGOALS (asm_full_simp_tac (simpset_of ctxt))])),
   85.41 +            ALLGOALS (asm_full_simp_tac ctxt)])),
   85.42          length new_type_names))
   85.43        end)
   85.44        atoms;
   85.45 @@ -335,7 +335,7 @@
   85.46                    (perm_names ~~
   85.47                     map body_type perm_types ~~ perm_indnames)))))
   85.48             (fn {context = ctxt, ...} => EVERY [Datatype_Aux.ind_tac induct perm_indnames 1,
   85.49 -              ALLGOALS (asm_full_simp_tac (simpset_of ctxt addsimps [pt2', pt2_ax]))]))),
   85.50 +              ALLGOALS (asm_full_simp_tac (ctxt addsimps [pt2', pt2_ax]))]))),
   85.51           length new_type_names)
   85.52        end) atoms;
   85.53  
   85.54 @@ -371,7 +371,7 @@
   85.55                    (perm_names ~~
   85.56                     map body_type perm_types ~~ perm_indnames))))))
   85.57             (fn {context = ctxt, ...} => EVERY [Datatype_Aux.ind_tac induct perm_indnames 1,
   85.58 -              ALLGOALS (asm_full_simp_tac (simpset_of ctxt addsimps [pt3', pt3_rev', pt3_ax]))]))),
   85.59 +              ALLGOALS (asm_full_simp_tac (ctxt addsimps [pt3', pt3_rev', pt3_ax]))]))),
   85.60           length new_type_names)
   85.61        end) atoms;
   85.62  
   85.63 @@ -393,7 +393,7 @@
   85.64          val permT2 = mk_permT (Type (name2, []));
   85.65          val Ts = map body_type perm_types;
   85.66          val cp_inst = cp_inst_of thy name1 name2;
   85.67 -        fun simps ctxt = simpset_of ctxt addsimps (perm_fun_def ::
   85.68 +        fun simps ctxt = ctxt addsimps (perm_fun_def ::
   85.69            (if name1 <> name2 then
   85.70               let val dj = dj_thm_of thy name2 name1
   85.71               in [dj RS (cp_inst RS dj_cp), dj RS dj_perm_perm_forget] end
   85.72 @@ -563,7 +563,7 @@
   85.73                 end) (rep_set_names'' ~~ recTs' ~~ perm_indnames')))))
   85.74          (fn {context = ctxt, ...} => EVERY
   85.75             [Datatype_Aux.ind_tac rep_induct [] 1,
   85.76 -            ALLGOALS (simp_tac (simpset_of ctxt addsimps
   85.77 +            ALLGOALS (simp_tac (ctxt addsimps
   85.78                (Thm.symmetric perm_fun_def :: abs_perm))),
   85.79              ALLGOALS (resolve_tac rep_intrs THEN_ALL_NEW assume_tac)])),
   85.80          length new_type_names));
   85.81 @@ -623,10 +623,10 @@
   85.82                map (inter_sort thy sort o snd) tvs, [pt_class])
   85.83              (fn ctxt => EVERY [Class.intro_classes_tac [],
   85.84                rewrite_goals_tac [perm_def],
   85.85 -              asm_full_simp_tac (simpset_of ctxt addsimps [Rep_inverse]) 1,
   85.86 -              asm_full_simp_tac (simpset_of ctxt addsimps
   85.87 +              asm_full_simp_tac (ctxt addsimps [Rep_inverse]) 1,
   85.88 +              asm_full_simp_tac (ctxt addsimps
   85.89                  [Rep RS perm_closed RS Abs_inverse]) 1,
   85.90 -              asm_full_simp_tac (HOL_basic_ss addsimps [Global_Theory.get_thm thy
   85.91 +              asm_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [Global_Theory.get_thm thy
   85.92                  ("pt_" ^ Long_Name.base_name atom ^ "3")]) 1]) thy
   85.93              |> Theory.checkpoint
   85.94            end)
   85.95 @@ -653,7 +653,7 @@
   85.96                map (inter_sort thy sort o snd) tvs, [cp_class])
   85.97              (fn ctxt => EVERY [Class.intro_classes_tac [],
   85.98                rewrite_goals_tac [perm_def],
   85.99 -              asm_full_simp_tac (simpset_of ctxt addsimps
  85.100 +              asm_full_simp_tac (ctxt addsimps
  85.101                  ((Rep RS perm_closed1 RS Abs_inverse) ::
  85.102                   (if atom1 = atom2 then []
  85.103                    else [Rep RS perm_closed2 RS Abs_inverse]))) 1,
  85.104 @@ -825,7 +825,8 @@
  85.105              (HOLogic.mk_Trueprop (HOLogic.mk_eq
  85.106                (Const ("Nominal.perm", permT --> U --> U) $ pi $ (Rep $ x),
  85.107                 Rep $ (Const ("Nominal.perm", permT --> T --> T) $ pi $ x)))))
  85.108 -          (fn _ => simp_tac (HOL_basic_ss addsimps (perm_defs @ Abs_inverse_thms @
  85.109 +          (fn {context = ctxt, ...} =>
  85.110 +            simp_tac (put_simpset HOL_basic_ss ctxt addsimps (perm_defs @ Abs_inverse_thms @
  85.111              perm_closed_thms @ Rep_thms)) 1)
  85.112        end) Rep_thms;
  85.113  
  85.114 @@ -842,7 +843,7 @@
  85.115        | prove_distinct_thms (p as (rep_thms, dist_lemma)) (t :: ts) =
  85.116            let
  85.117              val dist_thm = Goal.prove_global_future thy8 [] [] t (fn {context = ctxt, ...} =>
  85.118 -              simp_tac (simpset_of ctxt addsimps (dist_lemma :: rep_thms)) 1)
  85.119 +              simp_tac (ctxt addsimps (dist_lemma :: rep_thms)) 1)
  85.120            in
  85.121              dist_thm :: Drule.export_without_context (dist_thm RS not_sym) ::
  85.122                prove_distinct_thms p ts
  85.123 @@ -890,12 +891,12 @@
  85.124                (HOLogic.mk_Trueprop (HOLogic.mk_eq
  85.125                  (perm (list_comb (c, l_args)), list_comb (c, r_args)))))
  85.126              (fn {context = ctxt, ...} => EVERY
  85.127 -              [simp_tac (simpset_of ctxt addsimps (constr_rep_thm :: perm_defs)) 1,
  85.128 -               simp_tac (HOL_basic_ss addsimps (Rep_thms @ Abs_inverse_thms @
  85.129 +              [simp_tac (ctxt addsimps (constr_rep_thm :: perm_defs)) 1,
  85.130 +               simp_tac (put_simpset HOL_basic_ss ctxt addsimps (Rep_thms @ Abs_inverse_thms @
  85.131                   constr_defs @ perm_closed_thms)) 1,
  85.132 -               TRY (simp_tac (HOL_basic_ss addsimps
  85.133 +               TRY (simp_tac (put_simpset HOL_basic_ss ctxt addsimps
  85.134                   (Thm.symmetric perm_fun_def :: abs_perm)) 1),
  85.135 -               TRY (simp_tac (HOL_basic_ss addsimps
  85.136 +               TRY (simp_tac (put_simpset HOL_basic_ss ctxt addsimps
  85.137                   (perm_fun_def :: perm_defs @ Rep_thms @ Abs_inverse_thms @
  85.138                      perm_closed_thms)) 1)])
  85.139          end) (constrs ~~ constr_rep_thms)) (atoms ~~ perm_closed_thmss)
  85.140 @@ -946,9 +947,10 @@
  85.141                  (HOLogic.mk_eq (list_comb (c, args1), list_comb (c, args2)),
  85.142                   foldr1 HOLogic.mk_conj eqs))))
  85.143              (fn {context = ctxt, ...} => EVERY
  85.144 -               [asm_full_simp_tac (simpset_of ctxt addsimps (constr_rep_thm ::
  85.145 +               [asm_full_simp_tac (ctxt addsimps (constr_rep_thm ::
  85.146                    rep_inject_thms')) 1,
  85.147 -                TRY (asm_full_simp_tac (HOL_basic_ss addsimps (fresh_def :: supp_def ::
  85.148 +                TRY (asm_full_simp_tac (put_simpset HOL_basic_ss ctxt
  85.149 +                  addsimps (fresh_def :: supp_def ::
  85.150                    alpha @ abs_perm @ abs_fresh @ rep_inject_thms @
  85.151                    perm_rep_perm_thms)) 1)])
  85.152          end) (constrs ~~ constr_rep_thms)
  85.153 @@ -989,8 +991,8 @@
  85.154                  (supp c,
  85.155                   if null dts then HOLogic.mk_set atomT []
  85.156                   else foldr1 (HOLogic.mk_binop @{const_abbrev union}) (map supp args2)))))
  85.157 -            (fn _ =>
  85.158 -              simp_tac (HOL_basic_ss addsimps (supp_def ::
  85.159 +            (fn {context = ctxt, ...} =>
  85.160 +              simp_tac (put_simpset HOL_basic_ss ctxt addsimps (supp_def ::
  85.161                   Un_assoc :: @{thm de_Morgan_conj} :: Collect_disj_eq :: finite_Un ::
  85.162                   Collect_False_empty :: finite_emptyI :: @{thms simp_thms} @
  85.163                   abs_perm @ abs_fresh @ inject_thms' @ perm_thms')) 1)
  85.164 @@ -1001,8 +1003,8 @@
  85.165                 (fresh c,
  85.166                  if null dts then @{term True}
  85.167                  else foldr1 HOLogic.mk_conj (map fresh args2)))))
  85.168 -             (fn _ =>
  85.169 -               simp_tac (HOL_ss addsimps [Un_iff, empty_iff, fresh_def, supp_thm]) 1))
  85.170 +             (fn {context = ctxt, ...} =>
  85.171 +               simp_tac (put_simpset HOL_ss ctxt addsimps [Un_iff, empty_iff, fresh_def, supp_thm]) 1))
  85.172          end) atoms) constrs
  85.173        end) (List.take (pdescr, length new_type_names) ~~ new_type_names ~~ inject_thms ~~ perm_simps')));
  85.174  
  85.175 @@ -1028,10 +1030,12 @@
  85.176      val indrule_lemma = Goal.prove_global_future thy8 [] []
  85.177        (Logic.mk_implies
  85.178          (HOLogic.mk_Trueprop (Datatype_Aux.mk_conj indrule_lemma_prems),
  85.179 -         HOLogic.mk_Trueprop (Datatype_Aux.mk_conj indrule_lemma_concls))) (fn _ => EVERY
  85.180 +         HOLogic.mk_Trueprop (Datatype_Aux.mk_conj indrule_lemma_concls)))
  85.181 +         (fn {context = ctxt, ...} => EVERY
  85.182             [REPEAT (etac conjE 1),
  85.183              REPEAT (EVERY
  85.184 -              [TRY (rtac conjI 1), full_simp_tac (HOL_basic_ss addsimps Rep_inverse_thms) 1,
  85.185 +              [TRY (rtac conjI 1),
  85.186 +               full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps Rep_inverse_thms) 1,
  85.187                 etac mp 1, resolve_tac Rep_thms 1])]);
  85.188  
  85.189      val Ps = map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of indrule_lemma)));
  85.190 @@ -1045,12 +1049,12 @@
  85.191      val dt_induct_prop = Datatype_Prop.make_ind descr';
  85.192      val dt_induct = Goal.prove_global_future thy8 []
  85.193        (Logic.strip_imp_prems dt_induct_prop) (Logic.strip_imp_concl dt_induct_prop)
  85.194 -      (fn {prems, ...} => EVERY
  85.195 +      (fn {prems, context = ctxt} => EVERY
  85.196          [rtac indrule_lemma' 1,
  85.197           (Datatype_Aux.ind_tac rep_induct [] THEN_ALL_NEW Object_Logic.atomize_prems_tac) 1,
  85.198           EVERY (map (fn (prem, r) => (EVERY
  85.199             [REPEAT (eresolve_tac Abs_inverse_thms' 1),
  85.200 -            simp_tac (HOL_basic_ss addsimps [Thm.symmetric r]) 1,
  85.201 +            simp_tac (put_simpset HOL_basic_ss ctxt addsimps [Thm.symmetric r]) 1,
  85.202              DEPTH_SOLVE_1 (ares_tac [prem] 1 ORELSE etac allE 1)]))
  85.203                  (prems ~~ constr_defs))]);
  85.204  
  85.205 @@ -1076,7 +1080,7 @@
  85.206                     (Const ("Nominal.supp", T --> HOLogic.mk_setT atomT) $ Free (s, T)))
  85.207                     (indnames ~~ recTs)))))
  85.208             (fn {context = ctxt, ...} => Datatype_Aux.ind_tac dt_induct indnames 1 THEN
  85.209 -            ALLGOALS (asm_full_simp_tac (simpset_of ctxt addsimps
  85.210 +            ALLGOALS (asm_full_simp_tac (ctxt addsimps
  85.211                (abs_supp @ supp_atm @
  85.212                 Global_Theory.get_thms thy8 ("fs_" ^ Long_Name.base_name atom ^ "1") @
  85.213                 flat supp_thms))))),
  85.214 @@ -1236,12 +1240,12 @@
  85.215                  Bound 0 $ p)))
  85.216            (fn _ => EVERY
  85.217              [resolve_tac exists_fresh' 1,
  85.218 -             simp_tac (HOL_ss addsimps (supp_prod :: finite_Un :: fs_atoms @
  85.219 +             simp_tac (put_simpset HOL_ss ctxt addsimps (supp_prod :: finite_Un :: fs_atoms @
  85.220                 fin_set_supp @ ths)) 1]);
  85.221          val (([(_, cx)], ths), ctxt') = Obtain.result
  85.222 -          (fn _ => EVERY
  85.223 +          (fn ctxt' => EVERY
  85.224              [etac exE 1,
  85.225 -             full_simp_tac (HOL_ss addsimps (fresh_prod :: fresh_atm)) 1,
  85.226 +             full_simp_tac (put_simpset HOL_ss ctxt' addsimps (fresh_prod :: fresh_atm)) 1,
  85.227               REPEAT (etac conjE 1)])
  85.228            [ex] ctxt
  85.229        in (freshs1 @ [term_of cx], freshs2 @ ths, ctxt') end;
  85.230 @@ -1281,16 +1285,16 @@
  85.231          (augment_sort thy9 fs_cp_sort ind_concl') (fn {prems, context} =>
  85.232        let
  85.233          val (prems1, prems2) = chop (length dt_atomTs) prems;
  85.234 -        val ind_ss2 = HOL_ss addsimps
  85.235 +        val ind_ss2 = put_simpset HOL_ss context addsimps
  85.236            finite_Diff :: abs_fresh @ abs_supp @ fs_atoms;
  85.237          val ind_ss1 = ind_ss2 addsimps fresh_left @ calc_atm @
  85.238            fresh_atm @ rev_simps @ app_simps;
  85.239 -        val ind_ss3 = HOL_ss addsimps abs_fun_eq1 ::
  85.240 +        val ind_ss3 = put_simpset HOL_ss context addsimps abs_fun_eq1 ::
  85.241            abs_perm @ calc_atm @ perm_swap;
  85.242 -        val ind_ss4 = HOL_basic_ss addsimps fresh_left @ prems1 @
  85.243 +        val ind_ss4 = put_simpset HOL_basic_ss context addsimps fresh_left @ prems1 @
  85.244            fin_set_fresh @ calc_atm;
  85.245 -        val ind_ss5 = HOL_basic_ss addsimps pt1_atoms;
  85.246 -        val ind_ss6 = HOL_basic_ss addsimps flat perm_simps';
  85.247 +        val ind_ss5 = put_simpset HOL_basic_ss context addsimps pt1_atoms;
  85.248 +        val ind_ss6 = put_simpset HOL_basic_ss context addsimps flat perm_simps';
  85.249          val th = Goal.prove context [] []
  85.250            (augment_sort thy9 fs_cp_sort aux_ind_concl)
  85.251            (fn {context = context1, ...} =>
  85.252 @@ -1332,7 +1336,7 @@
  85.253                                  cs @ [fold_rev (mk_perm []) (map perm_of_pair
  85.254                                    (bs ~~ cs)) t]) (xs'' ~~ freshs1')))))
  85.255                             (fn _ => EVERY
  85.256 -                              (simp_tac (HOL_ss addsimps flat inject_thms) 1 ::
  85.257 +                              (simp_tac (put_simpset HOL_ss context3 addsimps flat inject_thms) 1 ::
  85.258                                 REPEAT (FIRSTGOAL (rtac conjI)) ::
  85.259                                 maps (fn ((bs, t), cs) =>
  85.260                                   if null bs then []
  85.261 @@ -1352,7 +1356,7 @@
  85.262                                    simp_tac ind_ss1' i
  85.263                                | _ $ (Const (@{const_name Not}, _) $ _) =>
  85.264                                    resolve_tac freshs2' i
  85.265 -                              | _ => asm_simp_tac (HOL_basic_ss addsimps
  85.266 +                              | _ => asm_simp_tac (put_simpset HOL_basic_ss context3 addsimps
  85.267                                    pt2_atoms addsimprocs [perm_simproc]) i)) 1])
  85.268                         val final = Proof_Context.export context3 context2 [th]
  85.269                       in
  85.270 @@ -1380,11 +1384,12 @@
  85.271      val induct = Goal.prove_global_future thy9 []
  85.272        (map (augment_sort thy9 fs_cp_sort) ind_prems)
  85.273        (augment_sort thy9 fs_cp_sort ind_concl)
  85.274 -      (fn {prems, ...} => EVERY
  85.275 +      (fn {prems, context = ctxt} => EVERY
  85.276           [rtac induct_aux' 1,
  85.277            REPEAT (resolve_tac fs_atoms 1),
  85.278            REPEAT ((resolve_tac prems THEN_ALL_NEW
  85.279 -            (etac @{thm meta_spec} ORELSE' full_simp_tac (HOL_basic_ss addsimps [fresh_def]))) 1)])
  85.280 +            (etac @{thm meta_spec} ORELSE'
  85.281 +              full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [fresh_def]))) 1)])
  85.282  
  85.283      val (_, thy10) = thy9 |>
  85.284        Sign.add_path big_name |>
  85.285 @@ -1526,20 +1531,20 @@
  85.286            (Goal.prove_global_future thy11 [] []
  85.287              (augment_sort thy1 pt_cp_sort
  85.288                (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map HOLogic.mk_imp ps))))
  85.289 -            (fn _ => rtac rec_induct 1 THEN REPEAT
  85.290 +            (fn {context = ctxt, ...} => rtac rec_induct 1 THEN REPEAT
  85.291                 (simp_tac (Simplifier.global_context thy11 HOL_basic_ss
  85.292                    addsimps flat perm_simps'
  85.293                    addsimprocs [NominalPermeq.perm_simproc_app]) 1 THEN
  85.294                  (resolve_tac rec_intrs THEN_ALL_NEW
  85.295 -                 asm_simp_tac (HOL_ss addsimps (fresh_bij @ perm_bij))) 1))))
  85.296 +                 asm_simp_tac (put_simpset HOL_ss ctxt addsimps (fresh_bij @ perm_bij))) 1))))
  85.297          val ths' = map (fn ((P, Q), th) =>
  85.298            Goal.prove_global_future thy11 [] []
  85.299              (augment_sort thy1 pt_cp_sort
  85.300                (Logic.mk_implies (HOLogic.mk_Trueprop Q, HOLogic.mk_Trueprop P)))
  85.301 -            (fn _ => dtac (Thm.instantiate ([],
  85.302 +            (fn {context = ctxt, ...} => dtac (Thm.instantiate ([],
  85.303                   [(cterm_of thy11 (Var (("pi", 0), permT)),
  85.304                     cterm_of thy11 (Const ("List.rev", permT --> permT) $ pi))]) th) 1 THEN
  85.305 -               NominalPermeq.perm_simp_tac HOL_ss 1)) (ps ~~ ths)
  85.306 +               NominalPermeq.perm_simp_tac (put_simpset HOL_ss ctxt) 1)) (ps ~~ ths)
  85.307        in (ths, ths') end) dt_atomTs);
  85.308  
  85.309      (** finite support **)
  85.310 @@ -1568,9 +1573,9 @@
  85.311                         finite $ (Const ("Nominal.supp", U --> aset) $ y))
  85.312                     end) (recTs ~~ rec_result_Ts ~~ rec_sets ~~
  85.313                       (1 upto length recTs))))))
  85.314 -            (fn {prems = fins, ...} =>
  85.315 +            (fn {prems = fins, context = ctxt} =>
  85.316                (rtac rec_induct THEN_ALL_NEW cut_facts_tac fins) 1 THEN REPEAT
  85.317 -               (NominalPermeq.finite_guess_tac (HOL_ss addsimps [fs_name]) 1))))
  85.318 +               (NominalPermeq.finite_guess_tac (put_simpset HOL_ss ctxt addsimps [fs_name]) 1))))
  85.319        end) dt_atomTs;
  85.320  
  85.321      (** freshness **)
  85.322 @@ -1620,7 +1625,7 @@
  85.323                          cterm_of thy11 (Const ("Nominal.supp",
  85.324                            fastype_of tuple --> HOLogic.mk_setT aT) $ tuple))]
  85.325                        supports_fresh) 1,
  85.326 -                    simp_tac (HOL_basic_ss addsimps
  85.327 +                    simp_tac (put_simpset HOL_basic_ss context addsimps
  85.328                        [supports_def, Thm.symmetric fresh_def, fresh_prod]) 1,
  85.329                      REPEAT_DETERM (resolve_tac [allI, impI] 1),
  85.330                      REPEAT_DETERM (etac conjE 1),
  85.331 @@ -1630,12 +1635,12 @@
  85.332                         rtac (Thm.instantiate ([],
  85.333                           [(cterm_of thy11 (Var (("pi", 0), mk_permT aT)),
  85.334                             cterm_of thy11 (perm_of_pair (term_of a, term_of b)))]) eqvt_th) 1,
  85.335 -                       asm_simp_tac (HOL_ss addsimps
  85.336 +                       asm_simp_tac (put_simpset HOL_ss context addsimps
  85.337                           (prems' @ perm_swap @ perm_fresh_fresh)) 1]) context 1,
  85.338                      rtac rec_prem 1,
  85.339 -                    simp_tac (HOL_ss addsimps (fs_name ::
  85.340 +                    simp_tac (put_simpset HOL_ss context addsimps (fs_name ::
  85.341                        supp_prod :: finite_Un :: finite_prems)) 1,
  85.342 -                    simp_tac (HOL_ss addsimps (Thm.symmetric fresh_def ::
  85.343 +                    simp_tac (put_simpset HOL_ss context addsimps (Thm.symmetric fresh_def ::
  85.344                        fresh_prod :: fresh_prems)) 1]
  85.345                   end))
  85.346            end) (recTs ~~ rec_result_Ts ~~ rec_sets ~~ eqvt_ths)
  85.347 @@ -1677,11 +1682,11 @@
  85.348              [cut_facts_tac ths 1,
  85.349               REPEAT_DETERM (dresolve_tac (the (AList.lookup op = rec_fin_supp T)) 1),
  85.350               resolve_tac exists_fresh' 1,
  85.351 -             asm_simp_tac (HOL_ss addsimps (supp_prod :: finite_Un :: fs_atoms)) 1]);
  85.352 +             asm_simp_tac (put_simpset HOL_ss ctxt addsimps (supp_prod :: finite_Un :: fs_atoms)) 1]);
  85.353          val (([(_, cx)], ths), ctxt') = Obtain.result
  85.354            (fn _ => EVERY
  85.355              [etac exE 1,
  85.356 -             full_simp_tac (HOL_ss addsimps (fresh_prod :: fresh_atm)) 1,
  85.357 +             full_simp_tac (put_simpset HOL_ss ctxt addsimps (fresh_prod :: fresh_atm)) 1,
  85.358               REPEAT (etac conjE 1)])
  85.359            [ex] ctxt
  85.360        in (freshs1 @ [term_of cx], freshs2 @ ths, ctxt') end;
  85.361 @@ -1723,16 +1728,16 @@
  85.362             ([rtac induct_aux_rec 1] @
  85.363              maps (fn ((_, finite_ths), finite_th) =>
  85.364                [cut_facts_tac (finite_th :: finite_ths) 1,
  85.365 -               asm_simp_tac (HOL_ss addsimps [supp_prod, finite_Un]) 1])
  85.366 +               asm_simp_tac (put_simpset HOL_ss context addsimps [supp_prod, finite_Un]) 1])
  85.367                  (finite_thss ~~ finite_ctxt_ths) @
  85.368              maps (fn ((_, idxss), elim) => maps (fn idxs =>
  85.369 -              [full_simp_tac (HOL_ss addsimps [Thm.symmetric fresh_def, supp_prod, Un_iff]) 1,
  85.370 +              [full_simp_tac (put_simpset HOL_ss context addsimps [Thm.symmetric fresh_def, supp_prod, Un_iff]) 1,
  85.371                 REPEAT_DETERM (eresolve_tac [conjE, ex1E] 1),
  85.372                 rtac ex1I 1,
  85.373                 (resolve_tac rec_intrs THEN_ALL_NEW atac) 1,
  85.374                 rotate_tac ~1 1,
  85.375                 ((DETERM o etac elim) THEN_ALL_NEW full_simp_tac
  85.376 -                  (HOL_ss addsimps flat distinct_thms)) 1] @
  85.377 +                  (put_simpset HOL_ss context addsimps flat distinct_thms)) 1] @
  85.378                 (if null idxs then [] else [hyp_subst_tac 1,
  85.379                  SUBPROOF (fn {asms, concl, prems = prems', params, context = context', ...} =>
  85.380                    let
  85.381 @@ -1777,14 +1782,14 @@
  85.382  
  85.383                      (** as, bs, cs # K as ts, K bs us **)
  85.384                      val _ = warning "step 2: as, bs, cs # K as ts, K bs us";
  85.385 -                    val prove_fresh_ss = HOL_ss addsimps
  85.386 +                    val prove_fresh_simpset = put_simpset HOL_ss context'' addsimps
  85.387                        (finite_Diff :: flat fresh_thms @
  85.388                         fs_atoms @ abs_fresh @ abs_supp @ fresh_atm);
  85.389                      (* FIXME: avoid asm_full_simp_tac ? *)
  85.390                      fun prove_fresh ths y x = Goal.prove context'' [] []
  85.391                        (HOLogic.mk_Trueprop (fresh_const
  85.392                           (fastype_of x) (fastype_of y) $ x $ y))
  85.393 -                      (fn _ => cut_facts_tac ths 1 THEN asm_full_simp_tac prove_fresh_ss 1);
  85.394 +                      (fn _ => cut_facts_tac ths 1 THEN asm_full_simp_tac prove_fresh_simpset 1);
  85.395                      val constr_fresh_thms =
  85.396                        map (prove_fresh fresh_prems lhs) boundsl @
  85.397                        map (prove_fresh fresh_prems rhs) boundsr @
  85.398 @@ -1798,7 +1803,7 @@
  85.399                          (fold_rev (mk_perm []) pi1 lhs, fold_rev (mk_perm []) pi2 rhs)))
  85.400                        (fn _ => EVERY
  85.401                           [cut_facts_tac constr_fresh_thms 1,
  85.402 -                          asm_simp_tac (HOL_basic_ss addsimps perm_fresh_fresh) 1,
  85.403 +                          asm_simp_tac (put_simpset HOL_basic_ss context'' addsimps perm_fresh_fresh) 1,
  85.404                            rtac prem 1]);
  85.405  
  85.406                      (** pi1 o ts = pi2 o us **)
  85.407 @@ -1809,7 +1814,7 @@
  85.408                            (fold_rev (mk_perm []) pi1 t, fold_rev (mk_perm []) pi2 u)))
  85.409                          (fn _ => EVERY
  85.410                             [cut_facts_tac [pi1_pi2_eq] 1,
  85.411 -                            asm_full_simp_tac (HOL_ss addsimps
  85.412 +                            asm_full_simp_tac (put_simpset HOL_ss context'' addsimps
  85.413                                (calc_atm @ flat perm_simps' @
  85.414                                 fresh_prems' @ freshs2' @ abs_perm @
  85.415                                 alpha @ flat inject_thms)) 1]))
  85.416 @@ -1821,7 +1826,7 @@
  85.417                        Goal.prove context'' [] []
  85.418                          (HOLogic.mk_Trueprop (HOLogic.mk_eq
  85.419                            (fold_rev (mk_perm []) (rpi1 @ pi2) u, t)))
  85.420 -                        (fn _ => simp_tac (HOL_ss addsimps
  85.421 +                        (fn _ => simp_tac (put_simpset HOL_ss context'' addsimps
  85.422                             ((eq RS sym) :: perm_swap)) 1))
  85.423                          (map snd cargsl' ~~ map snd cargsr' ~~ pi1_pi2_eqs);
  85.424  
  85.425 @@ -1850,12 +1855,12 @@
  85.426                            (HOLogic.mk_Trueprop (S $ mk_pi x $ mk_pi y))
  85.427                            (fn _ => EVERY
  85.428                               (map eqvt_tac pi @
  85.429 -                              [simp_tac (HOL_ss addsimps (fresh_prems' @ freshs2' @
  85.430 +                              [simp_tac (put_simpset HOL_ss context'' addsimps (fresh_prems' @ freshs2' @
  85.431                                   perm_swap @ perm_fresh_fresh)) 1,
  85.432                                 rtac th 1]))
  85.433                        in
  85.434                          Simplifier.simplify
  85.435 -                          (HOL_basic_ss addsimps rpi1_pi2_eqs) th'
  85.436 +                          (put_simpset HOL_basic_ss context'' addsimps rpi1_pi2_eqs) th'
  85.437                        end) rec_prems2;
  85.438  
  85.439                      val ihs = filter (fn th => case prop_of th of
  85.440 @@ -1874,7 +1879,7 @@
  85.441                             (HOLogic.mk_Trueprop (HOLogic.mk_eq
  85.442                                (fold_rev (mk_perm []) pi1 lhs,
  85.443                                 fold_rev (mk_perm []) pi2 (strip_perm rhs))))
  85.444 -                           (fn _ => simp_tac (HOL_basic_ss addsimps
  85.445 +                           (fn _ => simp_tac (put_simpset HOL_basic_ss context'' addsimps
  85.446                                (th' :: perm_swap)) 1)
  85.447                        end) (rec_prems' ~~ ihs);
  85.448  
  85.449 @@ -1924,17 +1929,17 @@
  85.450                          (HOLogic.mk_Trueprop (fresh_const aT rT $
  85.451                              fold_rev (mk_perm []) (rpi2 @ pi1) a $
  85.452                              fold_rev (mk_perm []) (rpi2 @ pi1) rhs'))
  85.453 -                        (fn _ => simp_tac (HOL_ss addsimps fresh_bij) 1 THEN
  85.454 +                        (fn _ => simp_tac (put_simpset HOL_ss context'' addsimps fresh_bij) 1 THEN
  85.455                             rtac th 1)
  85.456                        in
  85.457                          Goal.prove context'' [] []
  85.458                            (HOLogic.mk_Trueprop (fresh_const aT rT $ b $ lhs'))
  85.459                            (fn _ => EVERY
  85.460                               [cut_facts_tac [th'] 1,
  85.461 -                              full_simp_tac (Simplifier.global_context thy11 HOL_ss
  85.462 +                              full_simp_tac (Simplifier.global_context thy11 HOL_ss  (* FIXME context'' (!?) *)
  85.463                                  addsimps rec_eqns @ pi1_pi2_eqs @ perm_swap
  85.464                                  addsimprocs [NominalPermeq.perm_simproc_app]) 1,
  85.465 -                              full_simp_tac (HOL_ss addsimps (calc_atm @
  85.466 +                              full_simp_tac (put_simpset HOL_ss context'' addsimps (calc_atm @
  85.467                                  fresh_prems' @ freshs2' @ perm_fresh_fresh)) 1])
  85.468                        end;
  85.469  
  85.470 @@ -1951,7 +1956,7 @@
  85.471                             REPEAT_DETERM (dresolve_tac
  85.472                               (the (AList.lookup op = rec_fin_supp_thms' aT)) 1),
  85.473                             NominalPermeq.fresh_guess_tac
  85.474 -                             (HOL_ss addsimps (freshs2 @
  85.475 +                             (put_simpset HOL_ss context'' addsimps (freshs2 @
  85.476                                  fs_atoms @ fresh_atm @
  85.477                                  maps snd finite_thss)) 1]);
  85.478  
  85.479 @@ -1964,16 +1969,16 @@
  85.480                      val pi1_pi2_result = Goal.prove context'' [] []
  85.481                        (HOLogic.mk_Trueprop (HOLogic.mk_eq
  85.482                          (fold_rev (mk_perm []) pi1 rhs', fold_rev (mk_perm []) pi2 lhs')))
  85.483 -                      (fn _ => simp_tac (Simplifier.context context'' HOL_ss
  85.484 +                      (fn _ => simp_tac (put_simpset HOL_ss context''
  85.485                             addsimps pi1_pi2_eqs @ rec_eqns
  85.486                             addsimprocs [NominalPermeq.perm_simproc_app]) 1 THEN
  85.487 -                         TRY (simp_tac (HOL_ss addsimps
  85.488 +                         TRY (simp_tac (put_simpset HOL_ss context'' addsimps
  85.489                             (fresh_prems' @ freshs2' @ calc_atm @ perm_fresh_fresh)) 1));
  85.490  
  85.491                      val _ = warning "final result";
  85.492                      val final = Goal.prove context'' [] [] (term_of concl)
  85.493                        (fn _ => cut_facts_tac [pi1_pi2_result RS sym] 1 THEN
  85.494 -                        full_simp_tac (HOL_basic_ss addsimps perm_fresh_fresh @
  85.495 +                        full_simp_tac (put_simpset HOL_basic_ss context'' addsimps perm_fresh_fresh @
  85.496                            fresh_results @ fresh_results') 1);
  85.497                      val final' = Proof_Context.export context'' context' [final];
  85.498                      val _ = warning "finished!"
    86.1 --- a/src/HOL/Nominal/nominal_fresh_fun.ML	Tue Apr 16 17:54:14 2013 +0200
    86.2 +++ b/src/HOL/Nominal/nominal_fresh_fun.ML	Thu Apr 18 17:07:01 2013 +0200
    86.3 @@ -129,9 +129,9 @@
    86.4      val thy = theory_of_thm thm;
    86.5      val abs_fresh = Global_Theory.get_thms thy "abs_fresh";
    86.6      val fresh_perm_app = Global_Theory.get_thms thy "fresh_perm_app";
    86.7 -    val ss = simpset_of ctxt;
    86.8 -    val ss' = ss addsimps fresh_prod::abs_fresh;
    86.9 -    val ss'' = ss' addsimps fresh_perm_app;
   86.10 +    val simp_ctxt =
   86.11 +      ctxt addsimps (fresh_prod :: abs_fresh)
   86.12 +      addsimps fresh_perm_app;
   86.13      val x = hd (tl (Misc_Legacy.term_vars (prop_of exI)));
   86.14      val goal = nth (prems_of thm) (i-1);
   86.15      val atom_name_opt = get_inner_fresh_fun goal;
   86.16 @@ -164,10 +164,10 @@
   86.17      val post_rewrite_tacs =
   86.18            [rtac pt_name_inst,
   86.19             rtac at_name_inst,
   86.20 -           TRY o SOLVED' (NominalPermeq.finite_guess_tac ss''),
   86.21 +           TRY o SOLVED' (NominalPermeq.finite_guess_tac simp_ctxt),
   86.22             inst_fresh vars params THEN'
   86.23 -           (TRY o SOLVED' (NominalPermeq.fresh_guess_tac ss'')) THEN'
   86.24 -           (TRY o SOLVED' (asm_full_simp_tac ss''))]
   86.25 +           (TRY o SOLVED' (NominalPermeq.fresh_guess_tac simp_ctxt)) THEN'
   86.26 +           (TRY o SOLVED' (asm_full_simp_tac simp_ctxt))]
   86.27    in
   86.28     ((if no_asm then no_tac else
   86.29      (subst_inner_asm_tac ctxt fresh_fun_app' i THEN (RANGE post_rewrite_tacs i)))
    87.1 --- a/src/HOL/Nominal/nominal_induct.ML	Tue Apr 16 17:54:14 2013 +0200
    87.2 +++ b/src/HOL/Nominal/nominal_induct.ML	Thu Apr 18 17:07:01 2013 +0200
    87.3 @@ -21,8 +21,8 @@
    87.4    Library.funpow (length Ts) HOLogic.mk_split
    87.5      (Var (xi, (HOLogic.unitT :: Ts) ---> Term.range_type T));
    87.6  
    87.7 -val split_all_tuples =
    87.8 -  Simplifier.full_simplify (HOL_basic_ss addsimps
    87.9 +fun split_all_tuples ctxt =
   87.10 +  Simplifier.full_simplify (put_simpset HOL_basic_ss ctxt addsimps
   87.11      [@{thm split_conv}, @{thm split_paired_all}, @{thm unit_all_eq1}, @{thm fresh_unit_elim}, @{thm fresh_prod_elim}] @
   87.12      @{thms fresh_star_unit_elim} @ @{thms fresh_star_prod_elim});
   87.13  
   87.14 @@ -90,7 +90,7 @@
   87.15      val atomized_defs = map (map (Conv.fconv_rule Induct.atomize_cterm)) defs;
   87.16  
   87.17      val finish_rule =
   87.18 -      split_all_tuples
   87.19 +      split_all_tuples defs_ctxt
   87.20        #> rename_params_rule true
   87.21          (map (Name.clean o Variable.revert_fixed defs_ctxt o fst) avoiding);
   87.22  
    88.1 --- a/src/HOL/Nominal/nominal_inductive.ML	Tue Apr 16 17:54:14 2013 +0200
    88.2 +++ b/src/HOL/Nominal/nominal_inductive.ML	Thu Apr 18 17:07:01 2013 +0200
    88.3 @@ -20,12 +20,12 @@
    88.4  
    88.5  fun rulify_term thy = Raw_Simplifier.rewrite_term thy inductive_rulify [];
    88.6  
    88.7 -val atomize_conv =
    88.8 +fun atomize_conv ctxt =
    88.9    Raw_Simplifier.rewrite_cterm (true, false, false) (K (K NONE))
   88.10 -    (HOL_basic_ss addsimps inductive_atomize);
   88.11 -val atomize_intr = Conv.fconv_rule (Conv.prems_conv ~1 atomize_conv);
   88.12 +    (put_simpset HOL_basic_ss ctxt addsimps inductive_atomize);
   88.13 +fun atomize_intr ctxt = Conv.fconv_rule (Conv.prems_conv ~1 (atomize_conv ctxt));
   88.14  fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
   88.15 -  (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
   88.16 +  (Conv.params_conv ~1 (K (Conv.prems_conv ~1 (atomize_conv ctxt))) ctxt));
   88.17  
   88.18  fun preds_of ps t = inter (op = o apsnd dest_Free) ps (Term.add_frees t []);
   88.19  
   88.20 @@ -40,7 +40,7 @@
   88.21    [(perm_boolI_pi, pi)] perm_boolI;
   88.22  
   88.23  fun mk_perm_bool_simproc names = Simplifier.simproc_global_i
   88.24 -  (theory_of_thm perm_bool) "perm_bool" [@{term "perm pi x"}] (fn thy => fn ss =>
   88.25 +  (theory_of_thm perm_bool) "perm_bool" [@{term "perm pi x"}] (fn ctxt =>
   88.26      fn Const (@{const_name Nominal.perm}, _) $ _ $ t =>
   88.27           if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
   88.28           then SOME perm_bool else NONE
   88.29 @@ -103,10 +103,10 @@
   88.30        else NONE
   88.31    | inst_conj_all _ _ _ _ _ = NONE;
   88.32  
   88.33 -fun inst_conj_all_tac k = EVERY
   88.34 +fun inst_conj_all_tac ctxt k = EVERY
   88.35    [TRY (EVERY [etac conjE 1, rtac conjI 1, atac 1]),
   88.36     REPEAT_DETERM_N k (etac allE 1),
   88.37 -   simp_tac (HOL_basic_ss addsimps [@{thm id_apply}]) 1];
   88.38 +   simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm id_apply}]) 1];
   88.39  
   88.40  fun map_term f t u = (case f t u of
   88.41        NONE => map_term' f t u | x => x)
   88.42 @@ -271,10 +271,10 @@
   88.43      val perm_pi_simp = Global_Theory.get_thms thy "perm_pi_simp";
   88.44      val pt2_atoms = map (fn aT => Global_Theory.get_thm thy
   88.45        ("pt_" ^ Long_Name.base_name (fst (dest_Type aT)) ^ "2")) atomTs;
   88.46 -    val eqvt_ss = Simplifier.global_context thy HOL_basic_ss
   88.47 +    val eqvt_ss = simpset_of (Simplifier.global_context thy HOL_basic_ss
   88.48        addsimps (eqvt_thms @ perm_pi_simp @ pt2_atoms)
   88.49        addsimprocs [mk_perm_bool_simproc [@{const_name Fun.id}],
   88.50 -        NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun];
   88.51 +        NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun]);
   88.52      val fresh_bij = Global_Theory.get_thms thy "fresh_bij";
   88.53      val perm_bij = Global_Theory.get_thms thy "perm_bij";
   88.54      val fs_atoms = map (fn aT => Global_Theory.get_thm thy
   88.55 @@ -299,10 +299,10 @@
   88.56              [resolve_tac exists_fresh' 1,
   88.57               resolve_tac fs_atoms 1]);
   88.58          val (([(_, cx)], ths), ctxt') = Obtain.result
   88.59 -          (fn _ => EVERY
   88.60 +          (fn ctxt' => EVERY
   88.61              [etac exE 1,
   88.62 -             full_simp_tac (HOL_ss addsimps (fresh_prod :: fresh_atm)) 1,
   88.63 -             full_simp_tac (HOL_basic_ss addsimps [@{thm id_apply}]) 1,
   88.64 +             full_simp_tac (put_simpset HOL_ss ctxt' addsimps (fresh_prod :: fresh_atm)) 1,
   88.65 +             full_simp_tac (put_simpset HOL_basic_ss ctxt' addsimps [@{thm id_apply}]) 1,
   88.66               REPEAT (etac conjE 1)])
   88.67            [ex] ctxt
   88.68        in (freshs1 @ [term_of cx], freshs2 @ ths, ctxt') end;
   88.69 @@ -312,7 +312,7 @@
   88.70          let val th = Goal.prove ctxt [] [] concl (fn {context, ...} =>
   88.71            rtac raw_induct 1 THEN
   88.72            EVERY (maps (fn ((((_, bvars, oprems, _), vc_compat_ths), ihyp), (vs, ihypt)) =>
   88.73 -            [REPEAT (rtac allI 1), simp_tac eqvt_ss 1,
   88.74 +            [REPEAT (rtac allI 1), simp_tac (put_simpset eqvt_ss context) 1,
   88.75               SUBPROOF (fn {prems = gprems, params, concl, context = ctxt', ...} =>
   88.76                 let
   88.77                   val (params', (pis, z)) =
   88.78 @@ -343,9 +343,9 @@
   88.79                      map (fold_rev (NominalDatatype.mk_perm [])
   88.80                        (rev pis' @ pis)) params' @ [z])) ihyp;
   88.81                   fun mk_pi th =
   88.82 -                   Simplifier.simplify (HOL_basic_ss addsimps [@{thm id_apply}]
   88.83 +                   Simplifier.simplify (put_simpset HOL_basic_ss ctxt addsimps [@{thm id_apply}]
   88.84                         addsimprocs [NominalDatatype.perm_simproc])
   88.85 -                     (Simplifier.simplify eqvt_ss
   88.86 +                     (Simplifier.simplify (put_simpset eqvt_ss ctxt)
   88.87                         (fold_rev (mk_perm_bool o cterm_of thy)
   88.88                           (rev pis' @ pis) th));
   88.89                   val (gprems1, gprems2) = split_list
   88.90 @@ -355,7 +355,7 @@
   88.91                          (map_thm ctxt (split_conj (K o I) names)
   88.92                             (etac conjunct1 1) monos NONE th,
   88.93                           mk_pi (the (map_thm ctxt (inst_conj_all names ps (rev pis''))
   88.94 -                           (inst_conj_all_tac (length pis'')) monos (SOME t) th))))
   88.95 +                           (inst_conj_all_tac ctxt (length pis'')) monos (SOME t) th))))
   88.96                        (gprems ~~ oprems)) |>> map_filter I;
   88.97                   val vc_compat_ths' = map (fn th =>
   88.98                     let
   88.99 @@ -368,29 +368,29 @@
  88.100                       val th'' = Goal.prove ctxt'' [] [] (HOLogic.mk_Trueprop
  88.101                           (bop (fold_rev (NominalDatatype.mk_perm []) pis lhs)
  88.102                              (fold_rev (NominalDatatype.mk_perm []) pis rhs)))
  88.103 -                       (fn _ => simp_tac (HOL_basic_ss addsimps
  88.104 +                       (fn _ => simp_tac (put_simpset HOL_basic_ss ctxt'' addsimps
  88.105                            (fresh_bij @ perm_bij)) 1 THEN rtac th' 1)
  88.106 -                   in Simplifier.simplify (eqvt_ss addsimps fresh_atm) th'' end)
  88.107 +                   in Simplifier.simplify (put_simpset eqvt_ss ctxt'' addsimps fresh_atm) th'' end)
  88.108                       vc_compat_ths;
  88.109                   val vc_compat_ths'' = NominalDatatype.mk_not_sym vc_compat_ths';
  88.110                   (** Since swap_simps simplifies (pi :: 'a prm) o (x :: 'b) to x **)
  88.111                   (** we have to pre-simplify the rewrite rules                   **)
  88.112 -                 val swap_simps_ss = HOL_ss addsimps swap_simps @
  88.113 -                    map (Simplifier.simplify (HOL_ss addsimps swap_simps))
  88.114 +                 val swap_simps_simpset = put_simpset HOL_ss ctxt'' addsimps swap_simps @
  88.115 +                    map (Simplifier.simplify (put_simpset HOL_ss ctxt'' addsimps swap_simps))
  88.116                        (vc_compat_ths'' @ freshs2');
  88.117                   val th = Goal.prove ctxt'' [] []
  88.118                     (HOLogic.mk_Trueprop (list_comb (P $ hd ts,
  88.119                       map (fold (NominalDatatype.mk_perm []) pis') (tl ts))))
  88.120 -                   (fn _ => EVERY ([simp_tac eqvt_ss 1, rtac ihyp' 1,
  88.121 +                   (fn _ => EVERY ([simp_tac (put_simpset eqvt_ss ctxt'') 1, rtac ihyp' 1,
  88.122                       REPEAT_DETERM_N (nprems_of ihyp - length gprems)
  88.123 -                       (simp_tac swap_simps_ss 1),
  88.124 +                       (simp_tac swap_simps_simpset 1),
  88.125                       REPEAT_DETERM_N (length gprems)
  88.126 -                       (simp_tac (HOL_basic_ss
  88.127 +                       (simp_tac (put_simpset HOL_basic_ss ctxt''
  88.128                            addsimps [inductive_forall_def']
  88.129                            addsimprocs [NominalDatatype.perm_simproc]) 1 THEN
  88.130                          resolve_tac gprems2 1)]));
  88.131                   val final = Goal.prove ctxt'' [] [] (term_of concl)
  88.132 -                   (fn _ => cut_facts_tac [th] 1 THEN full_simp_tac (HOL_ss
  88.133 +                   (fn _ => cut_facts_tac [th] 1 THEN full_simp_tac (put_simpset HOL_ss ctxt''
  88.134                       addsimps vc_compat_ths'' @ freshs2' @
  88.135                         perm_fresh_fresh @ fresh_atm) 1);
  88.136                   val final' = Proof_Context.export ctxt'' ctxt' [final];
  88.137 @@ -400,7 +400,7 @@
  88.138            cut_facts_tac [th] 1 THEN REPEAT (etac conjE 1) THEN
  88.139            REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
  88.140              etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
  88.141 -            asm_full_simp_tac (simpset_of ctxt) 1)
  88.142 +            asm_full_simp_tac ctxt 1)
  88.143          end) |> singleton (Proof_Context.export ctxt' ctxt);
  88.144  
  88.145      (** strong case analysis rule **)
  88.146 @@ -452,13 +452,13 @@
  88.147                     concl))
  88.148            in map mk_prem prems end) cases_prems;
  88.149  
  88.150 -    val cases_eqvt_ss = Simplifier.global_context thy HOL_ss
  88.151 +    val cases_eqvt_simpset = Simplifier.global_context thy HOL_ss
  88.152        addsimps eqvt_thms @ swap_simps @ perm_pi_simp
  88.153        addsimprocs [NominalPermeq.perm_simproc_app,
  88.154          NominalPermeq.perm_simproc_fun];
  88.155  
  88.156      val simp_fresh_atm = map
  88.157 -      (Simplifier.simplify (HOL_basic_ss addsimps fresh_atm));
  88.158 +      (Simplifier.simplify (Simplifier.global_context thy HOL_basic_ss addsimps fresh_atm));
  88.159  
  88.160      fun mk_cases_proof ((((name, thss), elim), (prem, args, concl, (prems, ctxt'))),
  88.161          prems') =
  88.162 @@ -520,16 +520,16 @@
  88.163                         SUBPROOF (fn {prems = fresh_hyps, ...} =>
  88.164                           let
  88.165                             val fresh_hyps' = NominalDatatype.mk_not_sym fresh_hyps;
  88.166 -                           val case_ss = cases_eqvt_ss addsimps freshs2' @
  88.167 +                           val case_simpset = cases_eqvt_simpset addsimps freshs2' @
  88.168                               simp_fresh_atm (vc_compat_ths' @ fresh_hyps');
  88.169 -                           val fresh_fresh_ss = case_ss addsimps perm_fresh_fresh;
  88.170 +                           val fresh_fresh_simpset = case_simpset addsimps perm_fresh_fresh;
  88.171                             val hyps1' = map
  88.172 -                             (mk_pis #> Simplifier.simplify fresh_fresh_ss) hyps1;
  88.173 +                             (mk_pis #> Simplifier.simplify fresh_fresh_simpset) hyps1;
  88.174                             val hyps2' = map
  88.175 -                             (mk_pis #> Simplifier.simplify case_ss) hyps2;
  88.176 +                             (mk_pis #> Simplifier.simplify case_simpset) hyps2;
  88.177                             val case_hyps' = hyps1' @ hyps2'
  88.178                           in
  88.179 -                           simp_tac case_ss 1 THEN
  88.180 +                           simp_tac case_simpset 1 THEN
  88.181                             REPEAT_DETERM (TRY (rtac conjI 1) THEN
  88.182                               resolve_tac case_hyps' 1)
  88.183                           end) ctxt4 1)
  88.184 @@ -547,11 +547,11 @@
  88.185          val ind_case_names = Rule_Cases.case_names induct_cases;
  88.186          val induct_cases' = Inductive.partition_rules' raw_induct
  88.187            (intrs ~~ induct_cases); 
  88.188 -        val thss' = map (map atomize_intr) thss;
  88.189 +        val thss' = map (map (atomize_intr ctxt)) thss;
  88.190          val thsss = Inductive.partition_rules' raw_induct (intrs ~~ thss');
  88.191          val strong_raw_induct =
  88.192 -          mk_ind_proof ctxt thss' |> Inductive.rulify;
  88.193 -        val strong_cases = map (mk_cases_proof ##> Inductive.rulify)
  88.194 +          mk_ind_proof ctxt thss' |> Inductive.rulify ctxt;
  88.195 +        val strong_cases = map (mk_cases_proof ##> Inductive.rulify ctxt)
  88.196            (thsss ~~ elims ~~ cases_prems ~~ cases_prems');
  88.197          val strong_induct_atts =
  88.198            map (Attrib.internal o K)
  88.199 @@ -586,7 +586,7 @@
  88.200        Inductive.the_inductive ctxt (Sign.intern_const thy s);
  88.201      val raw_induct = atomize_induct ctxt raw_induct;
  88.202      val elims = map (atomize_induct ctxt) elims;
  88.203 -    val intrs = map atomize_intr intrs;
  88.204 +    val intrs = map (atomize_intr ctxt) intrs;
  88.205      val monos = Inductive.get_monos ctxt;
  88.206      val intrs' = Inductive.unpartition_rules intrs
  88.207        (map (fn (((s, ths), (_, k)), th) =>
  88.208 @@ -608,7 +608,7 @@
  88.209           atoms)
  88.210        end;
  88.211      val perm_pi_simp = Global_Theory.get_thms thy "perm_pi_simp";
  88.212 -    val eqvt_ss = Simplifier.global_context thy HOL_basic_ss addsimps
  88.213 +    val eqvt_simpset = Simplifier.global_context thy HOL_basic_ss addsimps
  88.214        (NominalThmDecls.get_eqvt_thms ctxt @ perm_pi_simp) addsimprocs
  88.215        [mk_perm_bool_simproc names,
  88.216         NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun];
  88.217 @@ -628,7 +628,7 @@
  88.218            let
  88.219              val prems' = map (fn th => the_default th (map_thm ctxt'
  88.220                (split_conj (K I) names) (etac conjunct2 1) monos NONE th)) prems;
  88.221 -            val prems'' = map (fn th => Simplifier.simplify eqvt_ss
  88.222 +            val prems'' = map (fn th => Simplifier.simplify eqvt_simpset
  88.223                (mk_perm_bool (cterm_of thy pi) th)) prems';
  88.224              val intr' = Drule.cterm_instantiate (map (cterm_of thy) vs ~~
  88.225                 map (cterm_of thy o NominalDatatype.mk_perm [] pi o term_of o #2) params)
  88.226 @@ -654,7 +654,7 @@
  88.227                  map (NominalDatatype.mk_perm [] pi') ts2))
  88.228              end) ps)))
  88.229            (fn {context, ...} => EVERY (rtac raw_induct 1 :: map (fn intr_vs =>
  88.230 -              full_simp_tac eqvt_ss 1 THEN
  88.231 +              full_simp_tac eqvt_simpset 1 THEN
  88.232                eqvt_tac context pi' intr_vs) intrs')) |>
  88.233            singleton (Proof_Context.export ctxt' ctxt)))
  88.234        end) atoms
    89.1 --- a/src/HOL/Nominal/nominal_inductive2.ML	Tue Apr 16 17:54:14 2013 +0200
    89.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML	Thu Apr 18 17:07:01 2013 +0200
    89.3 @@ -21,15 +21,15 @@
    89.4  
    89.5  fun rulify_term thy = Raw_Simplifier.rewrite_term thy inductive_rulify [];
    89.6  
    89.7 -val atomize_conv =
    89.8 +fun atomize_conv ctxt =
    89.9    Raw_Simplifier.rewrite_cterm (true, false, false) (K (K NONE))
   89.10 -    (HOL_basic_ss addsimps inductive_atomize);
   89.11 -val atomize_intr = Conv.fconv_rule (Conv.prems_conv ~1 atomize_conv);
   89.12 +    (put_simpset HOL_basic_ss ctxt addsimps inductive_atomize);
   89.13 +fun atomize_intr ctxt = Conv.fconv_rule (Conv.prems_conv ~1 (atomize_conv ctxt));
   89.14  fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
   89.15 -  (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
   89.16 +  (Conv.params_conv ~1 (K (Conv.prems_conv ~1 (atomize_conv ctxt))) ctxt));
   89.17  
   89.18 -val fresh_postprocess =
   89.19 -  Simplifier.full_simplify (HOL_basic_ss addsimps
   89.20 +fun fresh_postprocess ctxt =
   89.21 +  Simplifier.full_simplify (put_simpset HOL_basic_ss ctxt addsimps
   89.22      [@{thm fresh_star_set_eq}, @{thm fresh_star_Un_elim},
   89.23       @{thm fresh_star_insert_elim}, @{thm fresh_star_empty_elim}]);
   89.24  
   89.25 @@ -44,7 +44,7 @@
   89.26    [(perm_boolI_pi, pi)] perm_boolI;
   89.27  
   89.28  fun mk_perm_bool_simproc names = Simplifier.simproc_global_i
   89.29 -  (theory_of_thm perm_bool) "perm_bool" [@{term "perm pi x"}] (fn thy => fn ss =>
   89.30 +  (theory_of_thm perm_bool) "perm_bool" [@{term "perm pi x"}] (fn ctxt =>
   89.31      fn Const ("Nominal.perm", _) $ _ $ t =>
   89.32           if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
   89.33           then SOME perm_bool else NONE
   89.34 @@ -108,10 +108,10 @@
   89.35        else NONE
   89.36    | inst_conj_all _ _ _ _ _ = NONE;
   89.37  
   89.38 -fun inst_conj_all_tac k = EVERY
   89.39 +fun inst_conj_all_tac ctxt k = EVERY
   89.40    [TRY (EVERY [etac conjE 1, rtac conjI 1, atac 1]),
   89.41     REPEAT_DETERM_N k (etac allE 1),
   89.42 -   simp_tac (HOL_basic_ss addsimps [@{thm id_apply}]) 1];
   89.43 +   simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm id_apply}]) 1];
   89.44  
   89.45  fun map_term f t u = (case f t u of
   89.46        NONE => map_term' f t u | x => x)
   89.47 @@ -290,10 +290,10 @@
   89.48      val perm_pi_simp = Global_Theory.get_thms thy "perm_pi_simp";
   89.49      val pt2_atoms = map (fn a => Global_Theory.get_thm thy
   89.50        ("pt_" ^ Long_Name.base_name a ^ "2")) atoms;
   89.51 -    val eqvt_ss = Simplifier.global_context thy HOL_basic_ss
   89.52 +    val eqvt_ss = simpset_of (Simplifier.global_context thy HOL_basic_ss
   89.53        addsimps (eqvt_thms @ perm_pi_simp @ pt2_atoms)
   89.54        addsimprocs [mk_perm_bool_simproc ["Fun.id"],
   89.55 -        NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun];
   89.56 +        NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun]);
   89.57      val fresh_star_bij = Global_Theory.get_thms thy "fresh_star_bij";
   89.58      val pt_insts = map (NominalAtoms.pt_inst_of thy) atoms;
   89.59      val at_insts = map (NominalAtoms.at_inst_of thy) atoms;
   89.60 @@ -322,10 +322,10 @@
   89.61            [SOME (ctyp_of thy (fastype_of p))] [SOME (cterm_of thy p)]
   89.62            ([at_inst, fin, fs_atom] MRS @{thm at_set_avoiding});
   89.63          val (([(_, cx)], th1 :: th2 :: ths), ctxt') = Obtain.result
   89.64 -          (fn _ => EVERY
   89.65 +          (fn ctxt' => EVERY
   89.66              [rtac avoid_th 1,
   89.67 -             full_simp_tac (HOL_ss addsimps [@{thm fresh_star_prod_set}]) 1,
   89.68 -             full_simp_tac (HOL_basic_ss addsimps [@{thm id_apply}]) 1,
   89.69 +             full_simp_tac (put_simpset HOL_ss ctxt' addsimps [@{thm fresh_star_prod_set}]) 1,
   89.70 +             full_simp_tac (put_simpset HOL_basic_ss ctxt' addsimps [@{thm id_apply}]) 1,
   89.71               rotate_tac 1 1,
   89.72               REPEAT (etac conjE 1)])
   89.73            [] ctxt;
   89.74 @@ -340,8 +340,8 @@
   89.75                 (f $ fold_rev (NominalDatatype.mk_perm (rev pTs))
   89.76                    (pis1 @ pi :: pis2) l $ r)))
   89.77              (fn _ => cut_facts_tac [th2] 1 THEN
   89.78 -               full_simp_tac (HOL_basic_ss addsimps perm_set_forget) 1) |>
   89.79 -          Simplifier.simplify eqvt_ss
   89.80 +               full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps perm_set_forget) 1) |>
   89.81 +          Simplifier.simplify (put_simpset eqvt_ss ctxt)
   89.82        in
   89.83          (freshs @ [term_of cx],
   89.84           ths1 @ ths, ths2 @ [th1], ths3 @ [th2'], ctxt')
   89.85 @@ -353,7 +353,7 @@
   89.86            rtac raw_induct 1 THEN
   89.87            EVERY (maps (fn (((((_, sets, oprems, _),
   89.88                vc_compat_ths), vc_compat_vs), ihyp), vs_ihypt) =>
   89.89 -            [REPEAT (rtac allI 1), simp_tac eqvt_ss 1,
   89.90 +            [REPEAT (rtac allI 1), simp_tac (put_simpset eqvt_ss context) 1,
   89.91               SUBPROOF (fn {prems = gprems, params, concl, context = ctxt', ...} =>
   89.92                 let
   89.93                   val (cparams', (pis, z)) =
   89.94 @@ -379,14 +379,14 @@
   89.95                       Goal.prove ctxt' [] []
   89.96                         (HOLogic.mk_Trueprop (list_comb (h,
   89.97                            map (fold_rev (NominalDatatype.mk_perm []) pis) ts)))
   89.98 -                       (fn _ => simp_tac (HOL_basic_ss addsimps
   89.99 +                       (fn _ => simp_tac (put_simpset HOL_basic_ss ctxt' addsimps
  89.100                            (fresh_star_bij @ finite_ineq)) 1 THEN rtac th' 1)
  89.101                     end) vc_compat_ths vc_compat_vs;
  89.102                   val (vc_compat_ths1, vc_compat_ths2) =
  89.103                     chop (length vc_compat_ths - length sets) vc_compat_ths';
  89.104                   val vc_compat_ths1' = map
  89.105                     (Conv.fconv_rule (Conv.arg_conv (Conv.arg_conv
  89.106 -                      (Simplifier.rewrite eqvt_ss)))) vc_compat_ths1;
  89.107 +                      (Simplifier.rewrite (put_simpset eqvt_ss ctxt'))))) vc_compat_ths1;
  89.108                   val (pis', fresh_ths1, fresh_ths2, fresh_ths3, ctxt'') = fold
  89.109                     (obtain_fresh_name ts sets)
  89.110                     (map snd sets' ~~ vc_compat_ths2) ([], [], [], [], ctxt');
  89.111 @@ -401,16 +401,16 @@
  89.112                     (map (fold_rev (NominalDatatype.mk_perm [])
  89.113                        (pis' @ pis) #> cterm_of thy) params' @ [cterm_of thy z]);
  89.114                   fun mk_pi th =
  89.115 -                   Simplifier.simplify (HOL_basic_ss addsimps [@{thm id_apply}]
  89.116 +                   Simplifier.simplify (put_simpset HOL_basic_ss ctxt addsimps [@{thm id_apply}]
  89.117                         addsimprocs [NominalDatatype.perm_simproc])
  89.118 -                     (Simplifier.simplify eqvt_ss
  89.119 +                     (Simplifier.simplify (put_simpset eqvt_ss ctxt)
  89.120                         (fold_rev (mk_perm_bool o cterm_of thy)
  89.121                           (pis' @ pis) th));
  89.122                   val gprems2 = map (fn (th, t) =>
  89.123                     if null (preds_of ps t) then mk_pi th
  89.124                     else
  89.125                       mk_pi (the (map_thm ctxt (inst_conj_all names ps (rev pis''))
  89.126 -                       (inst_conj_all_tac (length pis'')) monos (SOME t) th)))
  89.127 +                       (inst_conj_all_tac ctxt (length pis'')) monos (SOME t) th)))
  89.128                     (gprems ~~ oprems);
  89.129                   val perm_freshs_freshs' = map (fn (th, (_, T)) =>
  89.130                     th RS the (AList.lookup op = perm_freshs_freshs T))
  89.131 @@ -418,15 +418,15 @@
  89.132                   val th = Goal.prove ctxt'' [] []
  89.133                     (HOLogic.mk_Trueprop (list_comb (P $ hd ts,
  89.134                       map (fold_rev (NominalDatatype.mk_perm []) pis') (tl ts))))
  89.135 -                   (fn _ => EVERY ([simp_tac eqvt_ss 1, rtac ihyp' 1] @
  89.136 +                   (fn _ => EVERY ([simp_tac (put_simpset eqvt_ss ctxt'') 1, rtac ihyp' 1] @
  89.137                       map (fn th => rtac th 1) fresh_ths3 @
  89.138                       [REPEAT_DETERM_N (length gprems)
  89.139 -                       (simp_tac (HOL_basic_ss
  89.140 +                       (simp_tac (put_simpset HOL_basic_ss ctxt''
  89.141                            addsimps [inductive_forall_def']
  89.142                            addsimprocs [NominalDatatype.perm_simproc]) 1 THEN
  89.143                          resolve_tac gprems2 1)]));
  89.144                   val final = Goal.prove ctxt'' [] [] (term_of concl)
  89.145 -                   (fn _ => cut_facts_tac [th] 1 THEN full_simp_tac (HOL_ss
  89.146 +                   (fn _ => cut_facts_tac [th] 1 THEN full_simp_tac (put_simpset HOL_ss ctxt''
  89.147                       addsimps vc_compat_ths1' @ fresh_ths1 @
  89.148                         perm_freshs_freshs') 1);
  89.149                   val final' = Proof_Context.export ctxt'' ctxt' [final];
  89.150 @@ -436,9 +436,9 @@
  89.151            cut_facts_tac [th] 1 THEN REPEAT (etac conjE 1) THEN
  89.152            REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
  89.153              etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
  89.154 -            asm_full_simp_tac (simpset_of ctxt) 1)
  89.155 +            asm_full_simp_tac ctxt 1)
  89.156          end) |>
  89.157 -        fresh_postprocess |>
  89.158 +        fresh_postprocess ctxt' |>
  89.159          singleton (Proof_Context.export ctxt' ctxt);
  89.160  
  89.161    in
  89.162 @@ -450,10 +450,10 @@
  89.163          val ind_case_names = Rule_Cases.case_names induct_cases;
  89.164          val induct_cases' = Inductive.partition_rules' raw_induct
  89.165            (intrs ~~ induct_cases); 
  89.166 -        val thss' = map (map atomize_intr) thss;
  89.167 +        val thss' = map (map (atomize_intr ctxt)) thss;
  89.168          val thsss = Inductive.partition_rules' raw_induct (intrs ~~ thss');
  89.169          val strong_raw_induct =
  89.170 -          mk_ind_proof ctxt thss' |> Inductive.rulify;
  89.171 +          mk_ind_proof ctxt thss' |> Inductive.rulify ctxt;
  89.172          val strong_induct_atts =
  89.173            map (Attrib.internal o K)
  89.174              [ind_case_names, Rule_Cases.consumes (~ (Thm.nprems_of strong_raw_induct))];
    90.1 --- a/src/HOL/Nominal/nominal_permeq.ML	Tue Apr 16 17:54:14 2013 +0200
    90.2 +++ b/src/HOL/Nominal/nominal_permeq.ML	Thu Apr 18 17:07:01 2013 +0200
    90.3 @@ -30,11 +30,11 @@
    90.4    val perm_simproc_fun : simproc
    90.5    val perm_simproc_app : simproc
    90.6  
    90.7 -  val perm_simp_tac : simpset -> int -> tactic
    90.8 -  val perm_extend_simp_tac : simpset -> int -> tactic
    90.9 -  val supports_tac : simpset -> int -> tactic
   90.10 -  val finite_guess_tac : simpset -> int -> tactic
   90.11 -  val fresh_guess_tac : simpset -> int -> tactic
   90.12 +  val perm_simp_tac : Proof.context -> int -> tactic
   90.13 +  val perm_extend_simp_tac : Proof.context -> int -> tactic
   90.14 +  val supports_tac : Proof.context -> int -> tactic
   90.15 +  val finite_guess_tac : Proof.context -> int -> tactic
   90.16 +  val fresh_guess_tac : Proof.context -> int -> tactic
   90.17  
   90.18    val perm_simp_meth : (Proof.context -> Proof.method) context_parser
   90.19    val perm_simp_meth_debug : (Proof.context -> Proof.method) context_parser
   90.20 @@ -90,8 +90,9 @@
   90.21  (* of applications; just adding this rule to the simplifier   *)
   90.22  (* would loop; it also needs careful tuning with the simproc  *)
   90.23  (* for functions to avoid further possibilities for looping   *)
   90.24 -fun perm_simproc_app' sg ss redex =
   90.25 +fun perm_simproc_app' ctxt redex =
   90.26    let 
   90.27 +    val thy = Proof_Context.theory_of ctxt;
   90.28      (* the "application" case is only applicable when the head of f is not a *)
   90.29      (* constant or when (f x) is a permuation with two or more arguments     *)
   90.30      fun applicable_app t = 
   90.31 @@ -107,8 +108,8 @@
   90.32              (if (applicable_app f) then
   90.33                let
   90.34                  val name = Long_Name.base_name n
   90.35 -                val at_inst = Global_Theory.get_thm sg ("at_" ^ name ^ "_inst")
   90.36 -                val pt_inst = Global_Theory.get_thm sg ("pt_" ^ name ^ "_inst")
   90.37 +                val at_inst = Global_Theory.get_thm thy ("at_" ^ name ^ "_inst")
   90.38 +                val pt_inst = Global_Theory.get_thm thy ("pt_" ^ name ^ "_inst")
   90.39                in SOME ((at_inst RS (pt_inst RS perm_eq_app)) RS eq_reflection) end
   90.40              else NONE)
   90.41        | _ => NONE
   90.42 @@ -118,7 +119,7 @@
   90.43    ["Nominal.perm pi x"] perm_simproc_app';
   90.44  
   90.45  (* a simproc that deals with permutation instances in front of functions  *)
   90.46 -fun perm_simproc_fun' sg ss redex = 
   90.47 +fun perm_simproc_fun' ctxt redex = 
   90.48     let 
   90.49       fun applicable_fun t =
   90.50         (case (strip_comb t) of
   90.51 @@ -140,36 +141,36 @@
   90.52  (* function for simplyfying permutations          *)
   90.53  (* stac contains the simplifiation tactic that is *)
   90.54  (* applied (see (no_asm) options below            *)
   90.55 -fun perm_simp_gen stac dyn_thms eqvt_thms ss i = 
   90.56 +fun perm_simp_gen stac dyn_thms eqvt_thms ctxt i = 
   90.57      ("general simplification of permutations", fn st =>
   90.58      let
   90.59 -       val ss' = Simplifier.global_context (theory_of_thm st) ss
   90.60 +       val ctxt' = ctxt
   90.61           addsimps (maps (dynamic_thms st) dyn_thms @ eqvt_thms)
   90.62           addsimprocs [perm_simproc_fun, perm_simproc_app]
   90.63           |> fold Simplifier.del_cong weak_congs
   90.64           |> fold Simplifier.add_cong strong_congs
   90.65      in
   90.66 -      stac ss' i st
   90.67 +      stac ctxt' i st
   90.68      end);
   90.69  
   90.70  (* general simplification of permutations and permutation that arose from eqvt-problems *)
   90.71 -fun perm_simp stac ss = 
   90.72 +fun perm_simp stac ctxt = 
   90.73      let val simps = ["perm_swap","perm_fresh_fresh","perm_bij","perm_pi_simp","swap_simps"]
   90.74      in 
   90.75 -        perm_simp_gen stac simps [] ss
   90.76 +        perm_simp_gen stac simps [] ctxt
   90.77      end;
   90.78  
   90.79 -fun eqvt_simp stac ss = 
   90.80 +fun eqvt_simp stac ctxt = 
   90.81      let val simps = ["perm_swap","perm_fresh_fresh","perm_pi_simp"]
   90.82 -        val eqvts_thms = NominalThmDecls.get_eqvt_thms (Simplifier.the_context ss);
   90.83 +        val eqvts_thms = NominalThmDecls.get_eqvt_thms ctxt;
   90.84      in 
   90.85 -        perm_simp_gen stac simps eqvts_thms ss
   90.86 +        perm_simp_gen stac simps eqvts_thms ctxt
   90.87      end;
   90.88  
   90.89  
   90.90  (* main simplification tactics for permutations *)
   90.91 -fun perm_simp_tac_gen_i stac tactical ss i = DETERM (tactical (perm_simp stac ss i));
   90.92 -fun eqvt_simp_tac_gen_i stac tactical ss i = DETERM (tactical (eqvt_simp stac ss i)); 
   90.93 +fun perm_simp_tac_gen_i stac tactical ctxt i = DETERM (tactical (perm_simp stac ctxt i));
   90.94 +fun eqvt_simp_tac_gen_i stac tactical ctxt i = DETERM (tactical (eqvt_simp stac ctxt i)); 
   90.95  
   90.96  val perm_simp_tac_i          = perm_simp_tac_gen_i simp_tac
   90.97  val perm_asm_simp_tac_i      = perm_simp_tac_gen_i asm_simp_tac
   90.98 @@ -187,28 +188,29 @@
   90.99  (* generating perm_aux'es for the outermost permutation and then un-   *)
  90.100  (* folding the definition                                              *)
  90.101  
  90.102 -fun perm_compose_simproc' sg ss redex =
  90.103 +fun perm_compose_simproc' ctxt redex =
  90.104    (case redex of
  90.105       (Const ("Nominal.perm", Type ("fun", [Type ("List.list", 
  90.106         [Type (@{type_name Product_Type.prod}, [T as Type (tname,_),_])]),_])) $ pi1 $ (Const ("Nominal.perm", 
  90.107           Type ("fun", [Type ("List.list", [Type (@{type_name Product_Type.prod}, [U as Type (uname,_),_])]),_])) $ 
  90.108            pi2 $ t)) =>
  90.109      let
  90.110 +      val thy = Proof_Context.theory_of ctxt
  90.111        val tname' = Long_Name.base_name tname
  90.112        val uname' = Long_Name.base_name uname
  90.113      in
  90.114        if pi1 <> pi2 then  (* only apply the composition rule in this case *)
  90.115          if T = U then    
  90.116            SOME (Drule.instantiate'
  90.117 -            [SOME (ctyp_of sg (fastype_of t))]
  90.118 -            [SOME (cterm_of sg pi1), SOME (cterm_of sg pi2), SOME (cterm_of sg t)]
  90.119 -            (mk_meta_eq ([Global_Theory.get_thm sg ("pt_"^tname'^"_inst"),
  90.120 -             Global_Theory.get_thm sg ("at_"^tname'^"_inst")] MRS pt_perm_compose_aux)))
  90.121 +            [SOME (ctyp_of thy (fastype_of t))]
  90.122 +            [SOME (cterm_of thy pi1), SOME (cterm_of thy pi2), SOME (cterm_of thy t)]
  90.123 +            (mk_meta_eq ([Global_Theory.get_thm thy ("pt_"^tname'^"_inst"),
  90.124 +             Global_Theory.get_thm thy ("at_"^tname'^"_inst")] MRS pt_perm_compose_aux)))
  90.125          else
  90.126            SOME (Drule.instantiate'
  90.127 -            [SOME (ctyp_of sg (fastype_of t))]
  90.128 -            [SOME (cterm_of sg pi1), SOME (cterm_of sg pi2), SOME (cterm_of sg t)]
  90.129 -            (mk_meta_eq (Global_Theory.get_thm sg ("cp_"^tname'^"_"^uname'^"_inst") RS 
  90.130 +            [SOME (ctyp_of thy (fastype_of t))]
  90.131 +            [SOME (cterm_of thy pi1), SOME (cterm_of thy pi2), SOME (cterm_of thy t)]
  90.132 +            (mk_meta_eq (Global_Theory.get_thm thy ("cp_"^tname'^"_"^uname'^"_inst") RS 
  90.133               cp1_aux)))
  90.134        else NONE
  90.135      end
  90.136 @@ -217,13 +219,12 @@
  90.137  val perm_compose_simproc = Simplifier.simproc_global @{theory} "perm_compose"
  90.138    ["Nominal.perm pi1 (Nominal.perm pi2 t)"] perm_compose_simproc';
  90.139  
  90.140 -fun perm_compose_tac ss i = 
  90.141 +fun perm_compose_tac ctxt i = 
  90.142    ("analysing permutation compositions on the lhs",
  90.143     fn st => EVERY
  90.144       [rtac trans i,
  90.145 -      asm_full_simp_tac (Simplifier.global_context (theory_of_thm st) empty_ss
  90.146 -        addsimprocs [perm_compose_simproc]) i,
  90.147 -      asm_full_simp_tac (HOL_basic_ss addsimps [perm_aux_fold]) i] st);
  90.148 +      asm_full_simp_tac (empty_simpset ctxt addsimprocs [perm_compose_simproc]) i,
  90.149 +      asm_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [perm_aux_fold]) i] st);
  90.150  
  90.151  fun apply_cong_tac i = ("application of congruence", cong_tac i);
  90.152  
  90.153 @@ -247,32 +248,32 @@
  90.154  (* to decide equation that come from support problems             *)
  90.155  (* since it contains looping rules the "recursion" - depth is set *)
  90.156  (* to 10 - this seems to be sufficient in most cases              *)
  90.157 -fun perm_extend_simp_tac_i tactical ss =
  90.158 -  let fun perm_extend_simp_tac_aux tactical ss n = 
  90.159 +fun perm_extend_simp_tac_i tactical ctxt =
  90.160 +  let fun perm_extend_simp_tac_aux tactical ctxt n = 
  90.161            if n=0 then K all_tac
  90.162            else DETERM o 
  90.163                 (FIRST'[fn i => tactical ("splitting conjunctions on the rhs", rtac conjI i),
  90.164 -                       fn i => tactical (perm_simp asm_full_simp_tac ss i),
  90.165 -                       fn i => tactical (perm_compose_tac ss i),
  90.166 +                       fn i => tactical (perm_simp asm_full_simp_tac ctxt i),
  90.167 +                       fn i => tactical (perm_compose_tac ctxt i),
  90.168                         fn i => tactical (apply_cong_tac i), 
  90.169                         fn i => tactical (unfold_perm_fun_def_tac i),
  90.170                         fn i => tactical (ext_fun_tac i)]
  90.171 -                      THEN_ALL_NEW (TRY o (perm_extend_simp_tac_aux tactical ss (n-1))))
  90.172 -  in perm_extend_simp_tac_aux tactical ss 10 end;
  90.173 +                      THEN_ALL_NEW (TRY o (perm_extend_simp_tac_aux tactical ctxt (n-1))))
  90.174 +  in perm_extend_simp_tac_aux tactical ctxt 10 end;
  90.175  
  90.176  
  90.177  (* tactic that tries to solve "supports"-goals; first it *)
  90.178  (* unfolds the support definition and strips off the     *)
  90.179  (* intros, then applies eqvt_simp_tac                    *)
  90.180 -fun supports_tac_i tactical ss i =
  90.181 +fun supports_tac_i tactical ctxt i =
  90.182    let 
  90.183       val simps        = [supports_def, Thm.symmetric fresh_def, fresh_prod]
  90.184    in
  90.185 -      EVERY [tactical ("unfolding of supports   ", simp_tac (HOL_basic_ss addsimps simps) i),
  90.186 +      EVERY [tactical ("unfolding of supports   ", simp_tac (put_simpset HOL_basic_ss ctxt addsimps simps) i),
  90.187               tactical ("stripping of foralls    ", REPEAT_DETERM (rtac allI i)),
  90.188               tactical ("geting rid of the imps  ", rtac impI i),
  90.189               tactical ("eliminating conjuncts   ", REPEAT_DETERM (etac  conjE i)),
  90.190 -             tactical ("applying eqvt_simp      ", eqvt_simp_tac_gen_i asm_full_simp_tac tactical ss i )]
  90.191 +             tactical ("applying eqvt_simp      ", eqvt_simp_tac_gen_i asm_full_simp_tac tactical ctxt i )]
  90.192    end;
  90.193  
  90.194  
  90.195 @@ -288,7 +289,7 @@
  90.196    | collect_vars i (t $ u) vs = collect_vars i u (collect_vars i t vs);
  90.197  
  90.198  (* FIXME proper SUBGOAL/CSUBGOAL instead of cprems_of etc. *)
  90.199 -fun finite_guess_tac_i tactical ss i st =
  90.200 +fun finite_guess_tac_i tactical ctxt i st =
  90.201      let val goal = nth (cprems_of st) (i - 1)
  90.202      in
  90.203        case Envir.eta_contract (Logic.strip_assums_concl (term_of goal)) of
  90.204 @@ -310,12 +311,12 @@
  90.205              val supports_rule'' = Drule.cterm_instantiate
  90.206                [(cert (head_of S), cert s')] supports_rule'
  90.207              val fin_supp = dynamic_thms st ("fin_supp")
  90.208 -            val ss' = ss addsimps [supp_prod,supp_unit,finite_Un,finite_emptyI,conj_absorb]@fin_supp
  90.209 +            val ctxt' = ctxt addsimps [supp_prod,supp_unit,finite_Un,finite_emptyI,conj_absorb]@fin_supp
  90.210            in
  90.211              (tactical ("guessing of the right supports-set",
  90.212                        EVERY [compose_tac (false, supports_rule'', 2) i,
  90.213 -                             asm_full_simp_tac ss' (i+1),
  90.214 -                             supports_tac_i tactical ss i])) st
  90.215 +                             asm_full_simp_tac ctxt' (i+1),
  90.216 +                             supports_tac_i tactical ctxt i])) st
  90.217            end
  90.218          | _ => Seq.empty
  90.219      end
  90.220 @@ -327,13 +328,13 @@
  90.221  (* it first collects all free variables and tries to show that the *) 
  90.222  (* support of these free variables (op supports) the goal          *)
  90.223  (* FIXME proper SUBGOAL/CSUBGOAL instead of cprems_of etc. *)
  90.224 -fun fresh_guess_tac_i tactical ss i st =
  90.225 +fun fresh_guess_tac_i tactical ctxt i st =
  90.226      let 
  90.227          val goal = nth (cprems_of st) (i - 1)
  90.228          val fin_supp = dynamic_thms st ("fin_supp")
  90.229          val fresh_atm = dynamic_thms st ("fresh_atm")
  90.230 -        val ss1 = ss addsimps [Thm.symmetric fresh_def,fresh_prod,fresh_unit,conj_absorb,not_false]@fresh_atm
  90.231 -        val ss2 = ss addsimps [supp_prod,supp_unit,finite_Un,finite_emptyI,conj_absorb]@fin_supp
  90.232 +        val ctxt1 = ctxt addsimps [Thm.symmetric fresh_def,fresh_prod,fresh_unit,conj_absorb,not_false]@fresh_atm
  90.233 +        val ctxt2 = ctxt addsimps [supp_prod,supp_unit,finite_Un,finite_emptyI,conj_absorb]@fin_supp
  90.234      in
  90.235        case Logic.strip_assums_concl (term_of goal) of
  90.236            _ $ (Const ("Nominal.fresh", Type ("fun", [T, _])) $ _ $ t) => 
  90.237 @@ -356,14 +357,14 @@
  90.238            in
  90.239              (tactical ("guessing of the right set that supports the goal", 
  90.240                        (EVERY [compose_tac (false, supports_fresh_rule'', 3) i,
  90.241 -                             asm_full_simp_tac ss1 (i+2),
  90.242 -                             asm_full_simp_tac ss2 (i+1), 
  90.243 -                             supports_tac_i tactical ss i]))) st
  90.244 +                             asm_full_simp_tac ctxt1 (i+2),
  90.245 +                             asm_full_simp_tac ctxt2 (i+1), 
  90.246 +                             supports_tac_i tactical ctxt i]))) st
  90.247            end
  90.248            (* when a term-constructor contains more than one binder, it is useful    *) 
  90.249            (* in nominal_primrecs to try whether the goal can be solved by an hammer *)
  90.250          | _ => (tactical ("if it is not of the form _\<sharp>_, then try the simplifier",   
  90.251 -                          (asm_full_simp_tac (HOL_ss addsimps [fresh_prod]@fresh_atm) i))) st
  90.252 +                          (asm_full_simp_tac (put_simpset HOL_ss ctxt addsimps [fresh_prod]@fresh_atm) i))) st
  90.253      end
  90.254      handle General.Subscript => Seq.empty;
  90.255  (* FIXME proper SUBGOAL/CSUBGOAL instead of cprems_of etc. *)
  90.256 @@ -399,19 +400,19 @@
  90.257  
  90.258  val perm_simp_meth =
  90.259    Scan.lift perm_simp_options --| Method.sections (Simplifier.simp_modifiers') >>
  90.260 -  (fn tac => fn ctxt => SIMPLE_METHOD' (CHANGED_PROP o tac (simpset_of ctxt)));
  90.261 +  (fn tac => fn ctxt => SIMPLE_METHOD' (CHANGED_PROP o tac ctxt));
  90.262  
  90.263  (* setup so that the simpset is used which is active at the moment when the tactic is called *)
  90.264  fun local_simp_meth_setup tac =
  90.265    Method.sections (Simplifier.simp_modifiers' @ Splitter.split_modifiers) >>
  90.266 -  (K (SIMPLE_METHOD' o tac o simpset_of));
  90.267 +  (K (SIMPLE_METHOD' o tac));
  90.268  
  90.269  (* uses HOL_basic_ss only and fails if the tactic does not solve the subgoal *)
  90.270  
  90.271  fun basic_simp_meth_setup debug tac =
  90.272 -  Scan.depend (fn ctxt => Scan.succeed (Simplifier.map_ss (fn _ => HOL_basic_ss) ctxt, ())) --
  90.273 +  Scan.depend (fn context => Scan.succeed (Simplifier.map_ss (put_simpset HOL_basic_ss) context, ())) --
  90.274    Method.sections (Simplifier.simp_modifiers' @ Splitter.split_modifiers) >>
  90.275 -  (K (SIMPLE_METHOD' o (if debug then tac else SOLVED' o tac) o simpset_of));
  90.276 +  (K (SIMPLE_METHOD' o (if debug then tac else SOLVED' o tac)));
  90.277  
  90.278  val perm_simp_meth_debug        = local_simp_meth_setup dperm_simp_tac;
  90.279  val perm_extend_simp_meth       = local_simp_meth_setup perm_extend_simp_tac;
    91.1 --- a/src/HOL/Nominal/nominal_thmdecls.ML	Tue Apr 16 17:54:14 2013 +0200
    91.2 +++ b/src/HOL/Nominal/nominal_thmdecls.ML	Thu Apr 18 17:07:01 2013 +0200
    91.3 @@ -64,7 +64,7 @@
    91.4                         dtac (Drule.cterm_instantiate [(mypi,mypifree)] orig_thm)),
    91.5              tactic ctxt ("getting rid of the pi on the right", rtac @{thm perm_boolI}),
    91.6              tactic ctxt ("getting rid of all remaining perms",
    91.7 -                       full_simp_tac (HOL_basic_ss addsimps perm_pi_simp))]
    91.8 +                       full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps perm_pi_simp))]
    91.9    end;
   91.10  
   91.11  fun get_derived_thm ctxt hyp concl orig_thm pi typi =
    92.1 --- a/src/HOL/Old_Number_Theory/Chinese.thy	Tue Apr 16 17:54:14 2013 +0200
    92.2 +++ b/src/HOL/Old_Number_Theory/Chinese.thy	Thu Apr 18 17:07:01 2013 +0200
    92.3 @@ -243,7 +243,7 @@
    92.4           prefer 6
    92.5           apply (simp add: mult_ac)
    92.6          apply (unfold xilin_sol_def)
    92.7 -        apply (tactic {* asm_simp_tac @{simpset} 6 *})
    92.8 +        apply (tactic {* asm_simp_tac @{context} 6 *})
    92.9          apply (rule_tac [6] ex1_implies_ex [THEN someI_ex])
   92.10          apply (rule_tac [6] unique_xi_sol)
   92.11             apply (rule_tac [3] funprod_zdvd)
    93.1 --- a/src/HOL/Old_Number_Theory/WilsonBij.thy	Tue Apr 16 17:54:14 2013 +0200
    93.2 +++ b/src/HOL/Old_Number_Theory/WilsonBij.thy	Thu Apr 18 17:07:01 2013 +0200
    93.3 @@ -143,7 +143,7 @@
    93.4          apply (rule_tac [7] zcong_trans)
    93.5           apply (tactic {* stac @{thm zcong_sym} 8 *})
    93.6           apply (erule_tac [7] inv_is_inv)
    93.7 -          apply (tactic "asm_simp_tac @{simpset} 9")
    93.8 +          apply (tactic "asm_simp_tac @{context} 9")
    93.9            apply (erule_tac [9] inv_is_inv)
   93.10             apply (rule_tac [6] zless_zprime_imp_zrelprime)
   93.11               apply (rule_tac [8] inv_less)
    94.1 --- a/src/HOL/Orderings.thy	Tue Apr 16 17:54:14 2013 +0200
    94.2 +++ b/src/HOL/Orderings.thy	Thu Apr 18 17:07:01 2013 +0200
    94.3 @@ -597,8 +597,8 @@
    94.4  
    94.5  fun prp t thm = Thm.prop_of thm = t;  (* FIXME aconv!? *)
    94.6  
    94.7 -fun prove_antisym_le sg ss ((le as Const(_,T)) $ r $ s) =
    94.8 -  let val prems = Simplifier.prems_of ss;
    94.9 +fun prove_antisym_le ctxt ((le as Const(_,T)) $ r $ s) =
   94.10 +  let val prems = Simplifier.prems_of ctxt;
   94.11        val less = Const (@{const_name less}, T);
   94.12        val t = HOLogic.mk_Trueprop(le $ s $ r);
   94.13    in case find_first (prp t) prems of
   94.14 @@ -612,8 +612,8 @@
   94.15    end
   94.16    handle THM _ => NONE;
   94.17  
   94.18 -fun prove_antisym_less sg ss (NotC $ ((less as Const(_,T)) $ r $ s)) =
   94.19 -  let val prems = Simplifier.prems_of ss;
   94.20 +fun prove_antisym_less ctxt (NotC $ ((less as Const(_,T)) $ r $ s)) =
   94.21 +  let val prems = Simplifier.prems_of ctxt;
   94.22        val le = Const (@{const_name less_eq}, T);
   94.23        val t = HOLogic.mk_Trueprop(le $ r $ s);
   94.24    in case find_first (prp t) prems of
   94.25 @@ -628,13 +628,13 @@
   94.26    handle THM _ => NONE;
   94.27  
   94.28  fun add_simprocs procs thy =
   94.29 -  Simplifier.map_simpset_global (fn ss => ss
   94.30 +  map_theory_simpset (fn ctxt => ctxt
   94.31      addsimprocs (map (fn (name, raw_ts, proc) =>
   94.32        Simplifier.simproc_global thy name raw_ts proc) procs)) thy;
   94.33  
   94.34  fun add_solver name tac =
   94.35 -  Simplifier.map_simpset_global (fn ss => ss addSolver
   94.36 -    mk_solver name (fn ss => tac (Simplifier.the_context ss) (Simplifier.prems_of ss)));
   94.37 +  map_theory_simpset (fn ctxt0 => ctxt0 addSolver
   94.38 +    mk_solver name (fn ctxt => tac ctxt (Simplifier.prems_of ctxt)));
   94.39  
   94.40  in
   94.41    add_simprocs [
    95.1 --- a/src/HOL/Probability/measurable.ML	Tue Apr 16 17:54:14 2013 +0200
    95.2 +++ b/src/HOL/Probability/measurable.ML	Thu Apr 18 17:07:01 2013 +0200
    95.3 @@ -8,7 +8,7 @@
    95.4  sig
    95.5    datatype level = Concrete | Generic
    95.6  
    95.7 -  val simproc : simpset -> cterm -> thm option
    95.8 +  val simproc : Proof.context -> cterm -> thm option
    95.9    val method : (Proof.context -> Method.method) context_parser
   95.10    val measurable_tac : Proof.context -> thm list -> tactic
   95.11  
   95.12 @@ -151,7 +151,8 @@
   95.13      in if null cps then no_tac else debug_tac ctxt (K "split countable fun") (resolve_tac cps i) end
   95.14      handle TERM _ => no_tac) 1)
   95.15  
   95.16 -fun measurable_tac' ctxt ss facts = let
   95.17 +fun measurable_tac' ctxt facts =
   95.18 +  let
   95.19  
   95.20      val imported_thms =
   95.21        (maps (import_theorem (Context.Proof ctxt) o Simplifier.norm_hhf) facts) @ get_all ctxt
   95.22 @@ -202,7 +203,7 @@
   95.23  
   95.24      val depth_measurable_tac = REPEAT_cnt (fn n =>
   95.25         (COND (is_cond_formula 1)
   95.26 -        (debug_tac ctxt (K ("simp " ^ string_of_int n)) (SOLVED' (asm_full_simp_tac ss) 1))
   95.27 +        (debug_tac ctxt (K ("simp " ^ string_of_int n)) (SOLVED' (asm_full_simp_tac ctxt) 1))
   95.28          ((debug_tac ctxt (K ("single " ^ string_of_int n)) (resolve_tac imported_thms 1)) APPEND
   95.29            (split_app_tac ctxt 1) APPEND
   95.30            (splitter 1)))) 0
   95.31 @@ -210,7 +211,7 @@
   95.32    in debug_tac ctxt (debug_facts "start") depth_measurable_tac end;
   95.33  
   95.34  fun measurable_tac ctxt facts =
   95.35 -  TAKE (Config.get ctxt backtrack) (measurable_tac' ctxt (simpset_of ctxt) facts);
   95.36 +  TAKE (Config.get ctxt backtrack) (measurable_tac' ctxt facts);
   95.37  
   95.38  val attr_add = Thm.declaration_attribute o add_thm;
   95.39  
   95.40 @@ -227,11 +228,11 @@
   95.41  val method : (Proof.context -> Method.method) context_parser =
   95.42    Scan.lift (Scan.succeed (fn ctxt => METHOD (fn facts => measurable_tac ctxt facts)));
   95.43  
   95.44 -fun simproc ss redex = let
   95.45 -    val ctxt = Simplifier.the_context ss;
   95.46 +fun simproc ctxt redex =
   95.47 +  let
   95.48      val t = HOLogic.mk_Trueprop (term_of redex);
   95.49      fun tac {context = ctxt, prems = _ } =
   95.50 -      SOLVE (measurable_tac' ctxt ss (Simplifier.prems_of ss));
   95.51 +      SOLVE (measurable_tac' ctxt (Simplifier.prems_of ctxt));
   95.52    in try (fn () => Goal.prove ctxt [] [] t tac RS @{thm Eq_TrueI}) () end;
   95.53  
   95.54  end
    96.1 --- a/src/HOL/Product_Type.thy	Tue Apr 16 17:54:14 2013 +0200
    96.2 +++ b/src/HOL/Product_Type.thy	Thu Apr 18 17:07:01 2013 +0200
    96.3 @@ -415,16 +415,21 @@
    96.4        | exists_paired_all (t $ u) = exists_paired_all t orelse exists_paired_all u
    96.5        | exists_paired_all (Abs (_, _, t)) = exists_paired_all t
    96.6        | exists_paired_all _ = false;
    96.7 -    val ss = HOL_basic_ss
    96.8 -      addsimps [@{thm split_paired_all}, @{thm unit_all_eq2}, @{thm unit_abs_eta_conv}]
    96.9 -      addsimprocs [@{simproc unit_eq}];
   96.10 +    val ss =
   96.11 +      simpset_of
   96.12 +       (put_simpset HOL_basic_ss @{context}
   96.13 +        addsimps [@{thm split_paired_all}, @{thm unit_all_eq2}, @{thm unit_abs_eta_conv}]
   96.14 +        addsimprocs [@{simproc unit_eq}]);
   96.15    in
   96.16 -    val split_all_tac = SUBGOAL (fn (t, i) =>
   96.17 -      if exists_paired_all t then safe_full_simp_tac ss i else no_tac);
   96.18 -    val unsafe_split_all_tac = SUBGOAL (fn (t, i) =>
   96.19 -      if exists_paired_all t then full_simp_tac ss i else no_tac);
   96.20 -    fun split_all th =
   96.21 -      if exists_paired_all (Thm.prop_of th) then full_simplify ss th else th;
   96.22 +    fun split_all_tac ctxt = SUBGOAL (fn (t, i) =>
   96.23 +      if exists_paired_all t then safe_full_simp_tac (put_simpset ss ctxt) i else no_tac);
   96.24 +
   96.25 +    fun unsafe_split_all_tac ctxt = SUBGOAL (fn (t, i) =>
   96.26 +      if exists_paired_all t then full_simp_tac (put_simpset ss ctxt) i else no_tac);
   96.27 +
   96.28 +    fun split_all ctxt th =
   96.29 +      if exists_paired_all (Thm.prop_of th)
   96.30 +      then full_simplify (put_simpset ss ctxt) th else th;
   96.31    end;
   96.32  *}
   96.33  
   96.34 @@ -451,7 +456,8 @@
   96.35  
   96.36  ML {*
   96.37  local
   96.38 -  val cond_split_eta_ss = HOL_basic_ss addsimps @{thms cond_split_eta};
   96.39 +  val cond_split_eta_ss =
   96.40 +    simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms cond_split_eta});
   96.41    fun Pair_pat k 0 (Bound m) = (m = k)
   96.42      | Pair_pat k i (Const (@{const_name Pair},  _) $ Bound m $ t) =
   96.43          i > 0 andalso m = k + i andalso Pair_pat k (i - 1) t
   96.44 @@ -463,9 +469,9 @@
   96.45    fun split_pat tp i (Abs  (_, _, t)) = if tp 0 i t then SOME (i, t) else NONE
   96.46      | split_pat tp i (Const (@{const_name prod_case}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
   96.47      | split_pat tp i _ = NONE;
   96.48 -  fun metaeq ss lhs rhs = mk_meta_eq (Goal.prove (Simplifier.the_context ss) [] []
   96.49 +  fun metaeq ctxt lhs rhs = mk_meta_eq (Goal.prove ctxt [] []
   96.50          (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)))
   96.51 -        (K (simp_tac (Simplifier.inherit_context ss cond_split_eta_ss) 1)));
   96.52 +        (K (simp_tac (put_simpset cond_split_eta_ss ctxt) 1)));
   96.53  
   96.54    fun beta_term_pat k i (Abs (_, _, t)) = beta_term_pat (k + 1) i t
   96.55      | beta_term_pat k i (t $ u) =
   96.56 @@ -479,20 +485,20 @@
   96.57          else (subst arg k i t $ subst arg k i u)
   96.58      | subst arg k i t = t;
   96.59  in
   96.60 -  fun beta_proc ss (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t) $ arg) =
   96.61 +  fun beta_proc ctxt (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t) $ arg) =
   96.62          (case split_pat beta_term_pat 1 t of
   96.63 -          SOME (i, f) => SOME (metaeq ss s (subst arg 0 i f))
   96.64 +          SOME (i, f) => SOME (metaeq ctxt s (subst arg 0 i f))
   96.65          | NONE => NONE)
   96.66      | beta_proc _ _ = NONE;
   96.67 -  fun eta_proc ss (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t)) =
   96.68 +  fun eta_proc ctxt (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t)) =
   96.69          (case split_pat eta_term_pat 1 t of
   96.70 -          SOME (_, ft) => SOME (metaeq ss s (let val (f $ arg) = ft in f end))
   96.71 +          SOME (_, ft) => SOME (metaeq ctxt s (let val (f $ arg) = ft in f end))
   96.72          | NONE => NONE)
   96.73      | eta_proc _ _ = NONE;
   96.74  end;
   96.75  *}
   96.76 -simproc_setup split_beta ("split f z") = {* fn _ => fn ss => fn ct => beta_proc ss (term_of ct) *}
   96.77 -simproc_setup split_eta ("split f") = {* fn _ => fn ss => fn ct => eta_proc ss (term_of ct) *}
   96.78 +simproc_setup split_beta ("split f z") = {* fn _ => fn ctxt => fn ct => beta_proc ctxt (term_of ct) *}
   96.79 +simproc_setup split_eta ("split f") = {* fn _ => fn ctxt => fn ct => eta_proc ctxt (term_of ct) *}
   96.80  
   96.81  lemma split_beta [mono]: "(%(x, y). P x y) z = P (fst z) (snd z)"
   96.82    by (subst surjective_pairing, rule split_conv)
   96.83 @@ -572,10 +578,11 @@
   96.84      | exists_p_split (t $ u) = exists_p_split t orelse exists_p_split u
   96.85      | exists_p_split (Abs (_, _, t)) = exists_p_split t
   96.86      | exists_p_split _ = false;
   96.87 -  val ss = HOL_basic_ss addsimps @{thms split_conv};
   96.88  in
   96.89 -val split_conv_tac = SUBGOAL (fn (t, i) =>
   96.90 -    if exists_p_split t then safe_full_simp_tac ss i else no_tac);
   96.91 +fun split_conv_tac ctxt = SUBGOAL (fn (t, i) =>
   96.92 +  if exists_p_split t
   96.93 +  then safe_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms split_conv}) i
   96.94 +  else no_tac);
   96.95  end;
   96.96  *}
   96.97  
   96.98 @@ -1154,7 +1161,7 @@
   96.99  ML_file "Tools/set_comprehension_pointfree.ML"
  96.100  
  96.101  setup {*
  96.102 -  Code_Preproc.map_pre (fn ss => ss addsimprocs
  96.103 +  Code_Preproc.map_pre (fn ctxt => ctxt addsimprocs
  96.104      [Raw_Simplifier.make_simproc {name = "set comprehension", lhss = [@{cpat "Collect ?P"}],
  96.105      proc = K Set_Comprehension_Pointfree.code_simproc, identifier = []}])
  96.106  *}
    97.1 --- a/src/HOL/Record_Benchmark/Record_Benchmark.thy	Tue Apr 16 17:54:14 2013 +0200
    97.2 +++ b/src/HOL/Record_Benchmark/Record_Benchmark.thy	Thu Apr 18 17:07:01 2013 +0200
    97.3 @@ -355,46 +355,50 @@
    97.4    by simp
    97.5  
    97.6  lemma "(r\<lparr>A255:=x,A253:=y,A255:=z \<rparr>) = r\<lparr>A253:=y,A255:=z\<rparr>"
    97.7 -  apply (tactic {* simp_tac (HOL_basic_ss addsimprocs [Record.upd_simproc]) 1*})
    97.8 +  apply (tactic {* simp_tac
    97.9 +    (put_simpset HOL_basic_ss @{context} addsimprocs [Record.upd_simproc]) 1*})
   97.10    done
   97.11  
   97.12  lemma "(\<forall>r. P (A155 r)) \<longrightarrow> (\<forall>x. P x)"
   97.13 -  apply (tactic {* simp_tac (HOL_basic_ss addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.14 +  apply (tactic {* simp_tac
   97.15 +    (put_simpset HOL_basic_ss @{context} addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.16    apply simp
   97.17    done
   97.18  
   97.19  lemma "(\<forall>r. P (A155 r)) \<longrightarrow> (\<forall>x. P x)"
   97.20 -  apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.21 +  apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.22    apply simp
   97.23    done
   97.24  
   97.25  lemma "(\<exists>r. P (A155 r)) \<longrightarrow> (\<exists>x. P x)"
   97.26 -  apply (tactic {* simp_tac (HOL_basic_ss addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.27 +  apply (tactic {* simp_tac
   97.28 +    (put_simpset HOL_basic_ss @{context} addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.29    apply simp
   97.30    done
   97.31  
   97.32  lemma "(\<exists>r. P (A155 r)) \<longrightarrow> (\<exists>x. P x)"
   97.33 -  apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.34 +  apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.35    apply simp
   97.36    done
   97.37  
   97.38  lemma "\<And>r. P (A155 r) \<Longrightarrow> (\<exists>x. P x)"
   97.39 -  apply (tactic {* simp_tac (HOL_basic_ss addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.40 +  apply (tactic {* simp_tac
   97.41 +    (put_simpset HOL_basic_ss @{context} addsimprocs [Record.split_simproc (K ~1)]) 1*})
   97.42    apply auto
   97.43    done
   97.44  
   97.45  lemma "\<And>r. P (A155 r) \<Longrightarrow> (\<exists>x. P x)"
   97.46 -  apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.47 +  apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.48    apply auto
   97.49    done
   97.50  
   97.51  lemma "P (A155 r) \<Longrightarrow> (\<exists>x. P x)"
   97.52 -  apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.53 +  apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.54    apply auto
   97.55    done
   97.56  
   97.57  lemma fixes r shows "P (A155 r) \<Longrightarrow> (\<exists>x. P x)"
   97.58 -  apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.59 +  apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.60    apply auto
   97.61    done
   97.62  
   97.63 @@ -405,14 +409,15 @@
   97.64    assume "P (A155 r)"
   97.65    then have "\<exists>x. P x"
   97.66      apply -
   97.67 -    apply (tactic {* Record.split_simp_tac [] (K ~1) 1*})
   97.68 +    apply (tactic {* Record.split_simp_tac @{context} [] (K ~1) 1*})
   97.69      apply auto 
   97.70      done
   97.71  end
   97.72  
   97.73  
   97.74  lemma "\<exists>r. A155 r = x"
   97.75 -  apply (tactic {*simp_tac (HOL_basic_ss addsimprocs [Record.ex_sel_eq_simproc]) 1*})
   97.76 +  apply (tactic {*simp_tac
   97.77 +    (put_simpset HOL_basic_ss @{context} addsimprocs [Record.ex_sel_eq_simproc]) 1*})
   97.78    done
   97.79  
   97.80  
    98.1 --- a/src/HOL/SET_Protocol/Message_SET.thy	Tue Apr 16 17:54:14 2013 +0200
    98.2 +++ b/src/HOL/SET_Protocol/Message_SET.thy	Thu Apr 18 17:07:01 2013 +0200
    98.3 @@ -853,12 +853,12 @@
    98.4                    impOfSubs @{thm Fake_parts_insert}] THEN'
    98.5      eresolve_tac [asm_rl, @{thm synth.Inj}];
    98.6  
    98.7 -fun Fake_insert_simp_tac ss i =
    98.8 -  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
    98.9 +fun Fake_insert_simp_tac ctxt i =
   98.10 +  REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ctxt i;
   98.11  
   98.12  fun atomic_spy_analz_tac ctxt =
   98.13    SELECT_GOAL
   98.14 -    (Fake_insert_simp_tac (simpset_of ctxt) 1 THEN
   98.15 +    (Fake_insert_simp_tac ctxt 1 THEN
   98.16        IF_UNSOLVED
   98.17          (Blast.depth_tac (ctxt addIs [@{thm analz_insertI},
   98.18              impOfSubs @{thm analz_subset_parts}]) 4 1));
   98.19 @@ -871,7 +871,7 @@
   98.20         (REPEAT o CHANGED)
   98.21             (res_inst_tac ctxt [(("x", 1), "X")] (insert_commute RS ssubst) 1),
   98.22         (*...allowing further simplifications*)
   98.23 -       simp_tac (simpset_of ctxt) 1,
   98.24 +       simp_tac ctxt 1,
   98.25         REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
   98.26         DEPTH_SOLVE (atomic_spy_analz_tac ctxt 1)]) i);
   98.27  *}
   98.28 @@ -932,7 +932,7 @@
   98.29      "for debugging spy_analz"
   98.30  
   98.31  method_setup Fake_insert_simp = {*
   98.32 -    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac o simpset_of) *}
   98.33 +    Scan.succeed (SIMPLE_METHOD' o Fake_insert_simp_tac) *}
   98.34      "for debugging spy_analz"
   98.35  
   98.36  end
    99.1 --- a/src/HOL/SET_Protocol/Public_SET.thy	Tue Apr 16 17:54:14 2013 +0200
    99.2 +++ b/src/HOL/SET_Protocol/Public_SET.thy	Thu Apr 18 17:07:01 2013 +0200
    99.3 @@ -344,7 +344,7 @@
    99.4  (*Tactic for possibility theorems*)
    99.5  fun possibility_tac ctxt =
    99.6      REPEAT (*omit used_Says so that Nonces start from different traces!*)
    99.7 -    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
    99.8 +    (ALLGOALS (simp_tac (ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
    99.9       THEN
   99.10       REPEAT_FIRST (eq_assume_tac ORELSE' 
   99.11                     resolve_tac [refl, conjI, @{thm Nonce_supply}]))
   99.12 @@ -353,7 +353,7 @@
   99.13    nonces and keys initially*)
   99.14  fun basic_possibility_tac ctxt =
   99.15      REPEAT 
   99.16 -    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
   99.17 +    (ALLGOALS (asm_simp_tac (ctxt setSolver safe_solver))
   99.18       THEN
   99.19       REPEAT_FIRST (resolve_tac [refl, conjI]))
   99.20  *}
   100.1 --- a/src/HOL/SPARK/Tools/spark_vcs.ML	Tue Apr 16 17:54:14 2013 +0200
   100.2 +++ b/src/HOL/SPARK/Tools/spark_vcs.ML	Thu Apr 18 17:07:01 2013 +0200
   100.3 @@ -211,17 +211,17 @@
   100.4           rtac @{thm subsetI} 1 THEN
   100.5           Datatype_Aux.exh_tac (K (#exhaust (Datatype.the_info
   100.6             (Proof_Context.theory_of lthy) tyname'))) 1 THEN
   100.7 -         ALLGOALS (asm_full_simp_tac (simpset_of lthy)));
   100.8 +         ALLGOALS (asm_full_simp_tac lthy));
   100.9  
  100.10      val finite_UNIV = Goal.prove lthy [] []
  100.11        (HOLogic.mk_Trueprop (Const (@{const_name finite},
  100.12           HOLogic.mk_setT T --> HOLogic.boolT) $ HOLogic.mk_UNIV T))
  100.13 -      (fn _ => simp_tac (simpset_of lthy addsimps [UNIV_eq]) 1);
  100.14 +      (fn _ => simp_tac (lthy addsimps [UNIV_eq]) 1);
  100.15  
  100.16      val card_UNIV = Goal.prove lthy [] []
  100.17        (HOLogic.mk_Trueprop (HOLogic.mk_eq
  100.18           (card, HOLogic.mk_number HOLogic.natT k)))
  100.19 -      (fn _ => simp_tac (simpset_of lthy addsimps [UNIV_eq]) 1);
  100.20 +      (fn _ => simp_tac (lthy addsimps [UNIV_eq]) 1);
  100.21  
  100.22      val range_pos = Goal.prove lthy [] []
  100.23        (HOLogic.mk_Trueprop (HOLogic.mk_eq
  100.24 @@ -233,12 +233,12 @@
  100.25                HOLogic.mk_number HOLogic.intT 0 $
  100.26                (@{term int} $ card))))
  100.27        (fn _ =>
  100.28 -         simp_tac (simpset_of lthy addsimps [card_UNIV]) 1 THEN
  100.29 -         simp_tac (simpset_of lthy addsimps [UNIV_eq, def1]) 1 THEN
  100.30 +         simp_tac (lthy addsimps [card_UNIV]) 1 THEN
  100.31 +         simp_tac (lthy addsimps [UNIV_eq, def1]) 1 THEN
  100.32           rtac @{thm subset_antisym} 1 THEN
  100.33 -         simp_tac (simpset_of lthy) 1 THEN
  100.34 +         simp_tac lthy 1 THEN
  100.35           rtac @{thm subsetI} 1 THEN
  100.36 -         asm_full_simp_tac (simpset_of lthy addsimps @{thms interval_expand}
  100.37 +         asm_full_simp_tac (lthy addsimps @{thms interval_expand}
  100.38             delsimps @{thms atLeastLessThan_iff}) 1);
  100.39  
  100.40      val lthy' =
  100.41 @@ -246,34 +246,31 @@
  100.42          Class.intro_classes_tac [] THEN
  100.43          rtac finite_UNIV 1 THEN
  100.44          rtac range_pos 1 THEN
  100.45 -        simp_tac (HOL_basic_ss addsimps [def3]) 1 THEN
  100.46 -        simp_tac (HOL_basic_ss addsimps [def2]) 1) lthy;
  100.47 +        simp_tac (put_simpset HOL_basic_ss lthy addsimps [def3]) 1 THEN
  100.48 +        simp_tac (put_simpset HOL_basic_ss lthy addsimps [def2]) 1) lthy;
  100.49  
  100.50      val (pos_eqs, val_eqs) = split_list (map_index (fn (i, c) =>
  100.51        let
  100.52          val n = HOLogic.mk_number HOLogic.intT i;
  100.53          val th = Goal.prove lthy' [] []
  100.54            (HOLogic.mk_Trueprop (HOLogic.mk_eq (p $ c, n)))
  100.55 -          (fn _ => simp_tac (simpset_of lthy' addsimps [def1]) 1);
  100.56 +          (fn _ => simp_tac (lthy' addsimps [def1]) 1);
  100.57          val th' = Goal.prove lthy' [] []
  100.58            (HOLogic.mk_Trueprop (HOLogic.mk_eq (v $ n, c)))
  100.59            (fn _ =>
  100.60               rtac (@{thm inj_pos} RS @{thm injD}) 1 THEN
  100.61 -             simp_tac (simpset_of lthy' addsimps
  100.62 -               [@{thm pos_val}, range_pos, card_UNIV, th]) 1)
  100.63 +             simp_tac (lthy' addsimps [@{thm pos_val}, range_pos, card_UNIV, th]) 1)
  100.64        in (th, th') end) cs);
  100.65  
  100.66      val first_el = Goal.prove lthy' [] []
  100.67        (HOLogic.mk_Trueprop (HOLogic.mk_eq
  100.68           (Const (@{const_name first_el}, T), hd cs)))
  100.69 -      (fn _ => simp_tac (simpset_of lthy' addsimps
  100.70 -         [@{thm first_el_def}, hd val_eqs]) 1);
  100.71 +      (fn _ => simp_tac (lthy' addsimps [@{thm first_el_def}, hd val_eqs]) 1);
  100.72  
  100.73      val last_el = Goal.prove lthy' [] []
  100.74        (HOLogic.mk_Trueprop (HOLogic.mk_eq
  100.75           (Const (@{const_name last_el}, T), List.last cs)))
  100.76 -      (fn _ => simp_tac (simpset_of lthy' addsimps
  100.77 -         [@{thm last_el_def}, List.last val_eqs, card_UNIV]) 1);
  100.78 +      (fn _ => simp_tac (lthy' addsimps [@{thm last_el_def}, List.last val_eqs, card_UNIV]) 1);
  100.79    in
  100.80      lthy' |>
  100.81      Local_Theory.note
   101.1 --- a/src/HOL/Set.thy	Tue Apr 16 17:54:14 2013 +0200
   101.2 +++ b/src/HOL/Set.thy	Thu Apr 18 17:07:01 2013 +0200
   101.3 @@ -380,7 +380,8 @@
   101.4  *}
   101.5  
   101.6  setup {*
   101.7 -  map_theory_claset (fn ctxt => ctxt addbefore ("bspec", dtac @{thm bspec} THEN' assume_tac))
   101.8 +  map_theory_claset (fn ctxt =>
   101.9 +    ctxt addbefore ("bspec", fn _ => dtac @{thm bspec} THEN' assume_tac))
  101.10  *}
  101.11  
  101.12  ML {*
   102.1 --- a/src/HOL/Statespace/distinct_tree_prover.ML	Tue Apr 16 17:54:14 2013 +0200
   102.2 +++ b/src/HOL/Statespace/distinct_tree_prover.ML	Thu Apr 18 17:07:01 2013 +0200
   102.3 @@ -356,16 +356,15 @@
   102.4      | _ => no_tac))
   102.5  
   102.6  fun distinctFieldSolver names =
   102.7 -  mk_solver "distinctFieldSolver" (distinctTree_tac names o Simplifier.the_context);
   102.8 +  mk_solver "distinctFieldSolver" (distinctTree_tac names);
   102.9  
  102.10  fun distinct_simproc names =
  102.11    Simplifier.simproc_global @{theory HOL} "DistinctTreeProver.distinct_simproc" ["x = y"]
  102.12 -    (fn thy => fn ss => fn (Const (@{const_name HOL.eq}, _) $ x $ y) =>
  102.13 -      (case try Simplifier.the_context ss of
  102.14 -        SOME ctxt =>
  102.15 +    (fn ctxt =>
  102.16 +      (fn Const (@{const_name HOL.eq}, _) $ x $ y =>
  102.17            Option.map (fn neq => @{thm neq_to_eq_False} OF [neq])
  102.18              (get_fst_success (neq_x_y ctxt x y) names)
  102.19 -      | NONE => NONE));
  102.20 +        | _ => NONE));
  102.21  
  102.22  end;
  102.23  
   103.1 --- a/src/HOL/Statespace/state_fun.ML	Tue Apr 16 17:54:14 2013 +0200
   103.2 +++ b/src/HOL/Statespace/state_fun.ML	Thu Apr 18 17:07:01 2013 +0200
   103.3 @@ -15,7 +15,7 @@
   103.4    val ex_lookup_eq_simproc : simproc
   103.5    val ex_lookup_ss : simpset
   103.6    val lazy_conj_simproc : simproc
   103.7 -  val string_eq_simp_tac : int -> tactic
   103.8 +  val string_eq_simp_tac : Proof.context -> int -> tactic
   103.9  
  103.10    val setup : theory -> theory
  103.11  end;
  103.12 @@ -54,44 +54,49 @@
  103.13  
  103.14  val lazy_conj_simproc =
  103.15    Simplifier.simproc_global @{theory HOL} "lazy_conj_simp" ["P & Q"]
  103.16 -    (fn thy => fn ss => fn t =>
  103.17 -      (case t of (Const (@{const_name HOL.conj},_) $ P $ Q) =>
  103.18 -        let
  103.19 -          val P_P' = Simplifier.rewrite ss (cterm_of thy P);
  103.20 -          val P' = P_P' |> prop_of |> Logic.dest_equals |> #2;
  103.21 -        in
  103.22 -          if isFalse P' then SOME (conj1_False OF [P_P'])
  103.23 -          else
  103.24 -            let
  103.25 -              val Q_Q' = Simplifier.rewrite ss (cterm_of thy Q);
  103.26 -              val Q' = Q_Q' |> prop_of |> Logic.dest_equals |> #2;
  103.27 -            in
  103.28 -              if isFalse Q' then SOME (conj2_False OF [Q_Q'])
  103.29 -              else if isTrue P' andalso isTrue Q' then SOME (conj_True OF [P_P', Q_Q'])
  103.30 -              else if P aconv P' andalso Q aconv Q' then NONE
  103.31 -              else SOME (conj_cong OF [P_P', Q_Q'])
  103.32 -            end
  103.33 -         end
  103.34 -      | _ => NONE));
  103.35 +    (fn ctxt => fn t =>
  103.36 +      let val thy = Proof_Context.theory_of ctxt in
  103.37 +        (case t of (Const (@{const_name HOL.conj},_) $ P $ Q) =>
  103.38 +          let
  103.39 +            val P_P' = Simplifier.rewrite ctxt (cterm_of thy P);
  103.40 +            val P' = P_P' |> prop_of |> Logic.dest_equals |> #2;
  103.41 +          in
  103.42 +            if isFalse P' then SOME (conj1_False OF [P_P'])
  103.43 +            else
  103.44 +              let
  103.45 +                val Q_Q' = Simplifier.rewrite ctxt (cterm_of thy Q);
  103.46 +                val Q' = Q_Q' |> prop_of |> Logic.dest_equals |> #2;
  103.47 +              in
  103.48 +                if isFalse Q' then SOME (conj2_False OF [Q_Q'])
  103.49 +                else if isTrue P' andalso isTrue Q' then SOME (conj_True OF [P_P', Q_Q'])
  103.50 +                else if P aconv P' andalso Q aconv Q' then NONE
  103.51 +                else SOME (conj_cong OF [P_P', Q_Q'])
  103.52 +              end
  103.53 +           end
  103.54 +        | _ => NONE)
  103.55 +      end);
  103.56  
  103.57 -val string_eq_simp_tac = simp_tac (HOL_basic_ss
  103.58 -  addsimps (@{thms list.inject} @ @{thms char.inject}
  103.59 -    @ @{thms list.distinct} @ @{thms char.distinct} @ @{thms simp_thms})
  103.60 -  addsimprocs [lazy_conj_simproc]
  103.61 -  |> Simplifier.add_cong @{thm block_conj_cong});
  103.62 +fun string_eq_simp_tac ctxt =
  103.63 +  simp_tac (put_simpset HOL_basic_ss ctxt
  103.64 +    addsimps (@{thms list.inject} @ @{thms char.inject}
  103.65 +      @ @{thms list.distinct} @ @{thms char.distinct} @ @{thms simp_thms})
  103.66 +    addsimprocs [lazy_conj_simproc]
  103.67 +    |> Simplifier.add_cong @{thm block_conj_cong});
  103.68  
  103.69  end;
  103.70  
  103.71 -val lookup_ss = (HOL_basic_ss
  103.72 -  addsimps (@{thms list.inject} @ @{thms char.inject}
  103.73 -    @ @{thms list.distinct} @ @{thms char.distinct} @ @{thms simp_thms}
  103.74 -    @ [@{thm StateFun.lookup_update_id_same}, @{thm StateFun.id_id_cancel},
  103.75 -      @{thm StateFun.lookup_update_same}, @{thm StateFun.lookup_update_other}])
  103.76 -  addsimprocs [lazy_conj_simproc]
  103.77 -  addSolver StateSpace.distinctNameSolver
  103.78 -  |> fold Simplifier.add_cong @{thms block_conj_cong});
  103.79 +val lookup_ss =
  103.80 +  simpset_of (put_simpset HOL_basic_ss @{context}
  103.81 +    addsimps (@{thms list.inject} @ @{thms char.inject}
  103.82 +      @ @{thms list.distinct} @ @{thms char.distinct} @ @{thms simp_thms}
  103.83 +      @ [@{thm StateFun.lookup_update_id_same}, @{thm StateFun.id_id_cancel},
  103.84 +        @{thm StateFun.lookup_update_same}, @{thm StateFun.lookup_update_other}])
  103.85 +    addsimprocs [lazy_conj_simproc]
  103.86 +    addSolver StateSpace.distinctNameSolver
  103.87 +    |> fold Simplifier.add_cong @{thms block_conj_cong});
  103.88  
  103.89 -val ex_lookup_ss = HOL_ss addsimps @{thms StateFun.ex_id};
  103.90 +val ex_lookup_ss =
  103.91 +  simpset_of (put_simpset HOL_ss @{context} addsimps @{thms StateFun.ex_id});
  103.92  
  103.93  
  103.94  structure Data = Generic_Data
  103.95 @@ -108,10 +113,11 @@
  103.96  
  103.97  val lookup_simproc =
  103.98    Simplifier.simproc_global @{theory} "lookup_simp" ["lookup d n (update d' c m v s)"]
  103.99 -    (fn thy => fn ss => fn t =>
 103.100 +    (fn ctxt => fn t =>
 103.101        (case t of (Const (@{const_name StateFun.lookup}, lT) $ destr $ n $
 103.102                     (s as Const (@{const_name StateFun.update}, uT) $ _ $ _ $ _ $ _ $ _)) =>
 103.103          (let
 103.104 +          val thy = Proof_Context.theory_of ctxt;
 103.105            val (_::_::_::_::sT::_) = binder_types uT;
 103.106            val mi = maxidx_of_term t;
 103.107            fun mk_upds (Const (@{const_name StateFun.update}, uT) $ d' $ c $ m $ v $ s) =
 103.108 @@ -140,10 +146,9 @@
 103.109  
 103.110            val ct =
 103.111              cterm_of thy (Const (@{const_name StateFun.lookup}, lT) $ destr $ n $ fst (mk_upds s));
 103.112 -          val ctxt = Simplifier.the_context ss;
 103.113            val basic_ss = #1 (Data.get (Context.Proof ctxt));
 103.114 -          val ss' = Simplifier.context (Config.put simp_depth_limit 100 ctxt) basic_ss;
 103.115 -          val thm = Simplifier.rewrite ss' ct;
 103.116 +          val ctxt' = ctxt |> Config.put simp_depth_limit 100 |> put_simpset basic_ss;
 103.117 +          val thm = Simplifier.rewrite ctxt' ct;
 103.118          in
 103.119            if (op aconv) (Logic.dest_equals (prop_of thm))
 103.120            then NONE
 103.121 @@ -156,17 +161,18 @@
 103.122  local
 103.123  
 103.124  val meta_ext = @{thm StateFun.meta_ext};
 103.125 -val ss' = (HOL_ss addsimps
 103.126 -  (@{thm StateFun.update_apply} :: @{thm Fun.o_apply} :: @{thms list.inject} @ @{thms char.inject}
 103.127 -    @ @{thms list.distinct} @ @{thms char.distinct})
 103.128 -  addsimprocs [lazy_conj_simproc, StateSpace.distinct_simproc]
 103.129 -  |> fold Simplifier.add_cong @{thms block_conj_cong});
 103.130 +val ss' =
 103.131 +  simpset_of (put_simpset HOL_ss @{context} addsimps
 103.132 +    (@{thm StateFun.update_apply} :: @{thm Fun.o_apply} :: @{thms list.inject} @ @{thms char.inject}
 103.133 +      @ @{thms list.distinct} @ @{thms char.distinct})
 103.134 +    addsimprocs [lazy_conj_simproc, StateSpace.distinct_simproc]
 103.135 +    |> fold Simplifier.add_cong @{thms block_conj_cong});
 103.136  
 103.137  in
 103.138  
 103.139  val update_simproc =
 103.140    Simplifier.simproc_global @{theory} "update_simp" ["update d c n v s"]
 103.141 -    (fn thy => fn ss => fn t =>
 103.142 +    (fn ctxt => fn t =>
 103.143        (case t of
 103.144          ((upd as Const (@{const_name StateFun.update}, uT)) $ d $ c $ n $ v $ s) =>
 103.145            let
 103.146 @@ -237,18 +243,18 @@
 103.147                    end
 103.148                | mk_updterm _ t = init_seed t;
 103.149  
 103.150 -            val ctxt = Simplifier.the_context ss |> Config.put simp_depth_limit 100;
 103.151 -            val ss1 = Simplifier.context ctxt ss';
 103.152 -            val ss2 = Simplifier.context ctxt (#1 (Data.get (Context.Proof ctxt)));
 103.153 +            val ctxt0 = Config.put simp_depth_limit 100 ctxt;
 103.154 +            val ctxt1 = put_simpset ss' ctxt0;
 103.155 +            val ctxt2 = put_simpset (#1 (Data.get (Context.Proof ctxt0))) ctxt0;
 103.156            in
 103.157              (case mk_updterm [] t of
 103.158                (trm, trm', vars, _, true) =>
 103.159                  let
 103.160                    val eq1 =
 103.161 -                    Goal.prove ctxt [] []
 103.162 +                    Goal.prove ctxt0 [] []
 103.163                        (Logic.list_all (vars, Logic.mk_equals (trm, trm')))
 103.164 -                      (fn _ => rtac meta_ext 1 THEN simp_tac ss1 1);
 103.165 -                  val eq2 = Simplifier.asm_full_rewrite ss2 (Thm.dest_equals_rhs (cprop_of eq1));
 103.166 +                      (fn _ => rtac meta_ext 1 THEN simp_tac ctxt1 1);
 103.167 +                  val eq2 = Simplifier.asm_full_rewrite ctxt2 (Thm.dest_equals_rhs (cprop_of eq1));
 103.168                  in SOME (Thm.transitive eq1 eq2) end
 103.169              | _ => NONE)
 103.170            end
 103.171 @@ -269,14 +275,15 @@
 103.172  
 103.173  val ex_lookup_eq_simproc =
 103.174    Simplifier.simproc_global @{theory HOL} "ex_lookup_eq_simproc" ["Ex t"]
 103.175 -    (fn thy => fn ss => fn t =>
 103.176 +    (fn ctxt => fn t =>
 103.177        let
 103.178 -        val ctxt = Simplifier.the_context ss |> Config.put simp_depth_limit 100;
 103.179 +        val thy = Proof_Context.theory_of ctxt;
 103.180 +
 103.181          val ex_lookup_ss = #2 (Data.get (Context.Proof ctxt));
 103.182 -        val ss' = Simplifier.context ctxt ex_lookup_ss;
 103.183 +        val ctxt' = ctxt |> Config.put simp_depth_limit 100 |> put_simpset ex_lookup_ss;
 103.184          fun prove prop =
 103.185            Goal.prove_global thy [] [] prop
 103.186 -            (fn _ => Record.split_simp_tac [] (K ~1) 1 THEN simp_tac ss' 1);
 103.187 +            (fn _ => Record.split_simp_tac ctxt [] (K ~1) 1 THEN simp_tac ctxt' 1);
 103.188  
 103.189          fun mkeq (swap, Teq, lT, lo, d, n, x, s) i =
 103.190            let
 103.191 @@ -364,18 +371,21 @@
 103.192  val mk_destr = gen_constr_destr (fn a => fn b => Syntax.const @{const_name Fun.comp} $ b $ a) "the_";
 103.193  
 103.194  
 103.195 -val statefun_simp_attr = Thm.declaration_attribute (fn thm => fn ctxt =>
 103.196 +val statefun_simp_attr = Thm.declaration_attribute (fn thm => fn context =>
 103.197    let
 103.198 -    val (lookup_ss, ex_lookup_ss, simprocs_active) = Data.get ctxt;
 103.199 +    val ctxt = Context.proof_of context;
 103.200 +    val (lookup_ss, ex_lookup_ss, simprocs_active) = Data.get context;
 103.201      val (lookup_ss', ex_lookup_ss') =
 103.202        (case concl_of thm of
 103.203 -        (_ $ ((Const (@{const_name Ex}, _) $ _))) => (lookup_ss, ex_lookup_ss addsimps [thm])
 103.204 -      | _ => (lookup_ss addsimps [thm], ex_lookup_ss));
 103.205 -    fun activate_simprocs ctxt =
 103.206 -      if simprocs_active then ctxt
 103.207 -      else Simplifier.map_ss (fn ss => ss addsimprocs [lookup_simproc, update_simproc]) ctxt;
 103.208 +        (_ $ ((Const (@{const_name Ex}, _) $ _))) =>
 103.209 +          (lookup_ss, simpset_map ctxt (Simplifier.add_simp thm) ex_lookup_ss)
 103.210 +      | _ =>
 103.211 +          (simpset_map ctxt (Simplifier.add_simp thm) lookup_ss, ex_lookup_ss));
 103.212 +    val activate_simprocs =
 103.213 +      if simprocs_active then I
 103.214 +      else Simplifier.map_ss (fn ctxt => ctxt addsimprocs [lookup_simproc, update_simproc]);
 103.215    in
 103.216 -    ctxt
 103.217 +    context
 103.218      |> activate_simprocs
 103.219      |> Data.put (lookup_ss', ex_lookup_ss', true)
 103.220    end);
   104.1 --- a/src/HOL/Statespace/state_space.ML	Tue Apr 16 17:54:14 2013 +0200
   104.2 +++ b/src/HOL/Statespace/state_space.ML	Thu Apr 18 17:07:01 2013 +0200
   104.3 @@ -225,22 +225,14 @@
   104.4        | NONE => no_tac)
   104.5    | _ => no_tac));
   104.6  
   104.7 -val distinctNameSolver =
   104.8 -  mk_solver "distinctNameSolver" (distinctTree_tac o Simplifier.the_context);
   104.9 +val distinctNameSolver = mk_solver "distinctNameSolver" distinctTree_tac;
  104.10  
  104.11  val distinct_simproc =
  104.12    Simplifier.simproc_global @{theory HOL} "StateSpace.distinct_simproc" ["x = y"]
  104.13 -    (fn thy => fn ss => (fn (Const (@{const_name HOL.eq},_)$(x as Free _)$(y as Free _)) =>
  104.14 -        (case try Simplifier.the_context ss of
  104.15 -          SOME ctxt =>
  104.16 -            Option.map (fn neq => DistinctTreeProver.neq_to_eq_False OF [neq])
  104.17 -              (neq_x_y ctxt x y)
  104.18 -        | NONE => NONE)
  104.19 +    (fn ctxt => (fn (Const (@{const_name HOL.eq},_)$(x as Free _)$(y as Free _)) =>
  104.20 +        Option.map (fn neq => DistinctTreeProver.neq_to_eq_False OF [neq]) (neq_x_y ctxt x y)
  104.21        | _ => NONE));
  104.22  
  104.23 -local
  104.24 -  val ss = HOL_basic_ss
  104.25 -in
  104.26  fun interprete_parent name dist_thm_name parent_expr thy =
  104.27    let
  104.28      fun solve_tac ctxt = CSUBGOAL (fn (goal, i) =>
  104.29 @@ -256,8 +248,6 @@
  104.30      thy |> prove_interpretation_in tac (name, parent_expr)
  104.31    end;
  104.32  
  104.33 -end;
  104.34 -
  104.35  fun namespace_definition name nameT parent_expr parent_comps new_comps thy =
  104.36    let
  104.37      val all_comps = parent_comps @ new_comps;
  104.38 @@ -283,14 +273,12 @@
  104.39                 | NONE => Symtab.update (name,thm) tt)
  104.40  
  104.41            val tt' = tt |> fold upd all_names;
  104.42 -          val activate_simproc =
  104.43 -            Simplifier.map_ss
  104.44 -              (Simplifier.with_context (Context_Position.set_visible false ctxt)
  104.45 -                (fn ss => ss addsimprocs [distinct_simproc]));
  104.46            val context' =
  104.47 -              context
  104.48 -              |> NameSpaceData.put {declinfo=declinfo,distinctthm=tt',silent=silent}
  104.49 -              |> activate_simproc;
  104.50 +              Context_Position.set_visible false ctxt
  104.51 +              addsimprocs [distinct_simproc]
  104.52 +              |> Context_Position.restore_visible ctxt
  104.53 +              |> Context.Proof
  104.54 +              |> NameSpaceData.put {declinfo=declinfo,distinctthm=tt',silent=silent};
  104.55          in context' end));
  104.56  
  104.57      val attr = Attrib.internal type_attr;
   105.1 --- a/src/HOL/String.thy	Tue Apr 16 17:54:14 2013 +0200
   105.2 +++ b/src/HOL/String.thy	Thu Apr 18 17:07:01 2013 +0200
   105.3 @@ -252,8 +252,9 @@
   105.4  setup {*
   105.5  let
   105.6    val nibbles = map_range (Thm.cterm_of @{theory} o HOLogic.mk_nibble) 16;
   105.7 -  val simpset = HOL_ss addsimps
   105.8 -    @{thms nat_of_nibble.simps mult_0 mult_1 add_0 add_0_right arith_simps numeral_plus_one};
   105.9 +  val simpset =
  105.10 +    put_simpset HOL_ss @{context}
  105.11 +      addsimps @{thms nat_of_nibble.simps mult_0 mult_1 add_0 add_0_right arith_simps numeral_plus_one};
  105.12    fun mk_code_eqn x y =
  105.13      Drule.instantiate' [] [SOME x, SOME y] @{thm nat_of_char_Char}
  105.14      |> simplify simpset;
   106.1 --- a/src/HOL/TLA/Buffer/DBuffer.thy	Tue Apr 16 17:54:14 2013 +0200
   106.2 +++ b/src/HOL/TLA/Buffer/DBuffer.thy	Thu Apr 18 17:07:01 2013 +0200
   106.3 @@ -59,7 +59,7 @@
   106.4    apply (rule square_simulation)
   106.5     apply clarsimp
   106.6    apply (tactic
   106.7 -    {* action_simp_tac (@{simpset} addsimps (@{thm hd_append} :: @{thms db_defs})) [] [] 1 *})
   106.8 +    {* action_simp_tac (@{context} addsimps (@{thm hd_append} :: @{thms db_defs})) [] [] 1 *})
   106.9    done
  106.10  
  106.11  
   107.1 --- a/src/HOL/TLA/Inc/Inc.thy	Tue Apr 16 17:54:14 2013 +0200
   107.2 +++ b/src/HOL/TLA/Inc/Inc.thy	Thu Apr 18 17:07:01 2013 +0200
   107.3 @@ -170,9 +170,9 @@
   107.4      --> (pc1 = #g ~> pc1 = #a)"
   107.5    apply (rule SF1)
   107.6      apply (tactic
   107.7 -      {* action_simp_tac (@{simpset} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
   107.8 +      {* action_simp_tac (@{context} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
   107.9     apply (tactic
  107.10 -      {* action_simp_tac (@{simpset} addsimps @{thm angle_def} :: @{thms Psi_defs}) [] [] 1 *})
  107.11 +      {* action_simp_tac (@{context} addsimps @{thm angle_def} :: @{thms Psi_defs}) [] [] 1 *})
  107.12    (* reduce |- []A --> <>Enabled B  to  |- A --> Enabled B *)
  107.13    apply (auto intro!: InitDmd_gen [temp_use] N1_enabled_at_g [temp_use]
  107.14      dest!: STL2_gen [temp_use] simp: Init_def)
  107.15 @@ -191,8 +191,8 @@
  107.16    "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True  
  107.17      --> (pc2 = #g ~> pc2 = #a)"
  107.18    apply (rule SF1)
  107.19 -  apply (tactic {* action_simp_tac (@{simpset} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.20 -  apply (tactic {* action_simp_tac (@{simpset} addsimps @{thm angle_def} :: @{thms Psi_defs})
  107.21 +  apply (tactic {* action_simp_tac (@{context} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.22 +  apply (tactic {* action_simp_tac (@{context} addsimps @{thm angle_def} :: @{thms Psi_defs})
  107.23      [] [] 1 *})
  107.24    apply (auto intro!: InitDmd_gen [temp_use] N2_enabled_at_g [temp_use]
  107.25      dest!: STL2_gen [temp_use] simp add: Init_def)
  107.26 @@ -211,9 +211,9 @@
  107.27      --> (pc2 = #b ~> pc2 = #g)"
  107.28    apply (rule SF1)
  107.29      apply (tactic
  107.30 -      {* action_simp_tac (@{simpset} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.31 +      {* action_simp_tac (@{context} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.32     apply (tactic
  107.33 -     {* action_simp_tac (@{simpset} addsimps @{thm angle_def} :: @{thms Psi_defs}) [] [] 1 *})
  107.34 +     {* action_simp_tac (@{context} addsimps @{thm angle_def} :: @{thms Psi_defs}) [] [] 1 *})
  107.35    apply (auto intro!: InitDmd_gen [temp_use] N2_enabled_at_b [temp_use]
  107.36      dest!: STL2_gen [temp_use] simp: Init_def)
  107.37    done
  107.38 @@ -253,9 +253,9 @@
  107.39           & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)   
  107.40           --> (pc1 = #a ~> pc1 = #b)"
  107.41    apply (rule SF1)
  107.42 -  apply (tactic {* action_simp_tac (@{simpset} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.43 +  apply (tactic {* action_simp_tac (@{context} addsimps @{thms Psi_defs}) [] [@{thm squareE}] 1 *})
  107.44    apply (tactic
  107.45 -    {* action_simp_tac (@{simpset} addsimps (@{thm angle_def} :: @{thms Psi_defs})) [] [] 1 *})
  107.46 +    {* action_simp_tac (@{context} addsimps (@{thm angle_def} :: @{thms Psi_defs})) [] [] 1 *})
  107.47    apply (clarsimp intro!: N1_enabled_at_both_a [THEN DmdImpl [temp_use]])
  107.48    apply (auto intro!: BoxDmd2_simple [temp_use] N2_live [temp_use]
  107.49      simp: split_box_conj more_temp_simps)
   108.1 --- a/src/HOL/TLA/Memory/MemClerk.thy	Tue Apr 16 17:54:14 2013 +0200
   108.2 +++ b/src/HOL/TLA/Memory/MemClerk.thy	Thu Apr 18 17:07:01 2013 +0200
   108.3 @@ -85,7 +85,7 @@
   108.4  lemma MClkFwd_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==>  
   108.5        |- Calling send p & ~Calling rcv p & cst!p = #clkA   
   108.6           --> Enabled (MClkFwd send rcv cst p)"
   108.7 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm MClkFwd_def},
   108.8 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm MClkFwd_def},
   108.9      @{thm Call_def}, @{thm caller_def}, @{thm rtrner_def}]) [exI]
  108.10      [@{thm base_enabled}, @{thm Pair_inject}] 1 *})
  108.11  
  108.12 @@ -100,9 +100,9 @@
  108.13  lemma MClkReply_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==>  
  108.14        |- Calling send p & ~Calling rcv p & cst!p = #clkB   
  108.15           --> Enabled (<MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))"
  108.16 -  apply (tactic {* action_simp_tac @{simpset}
  108.17 +  apply (tactic {* action_simp_tac @{context}
  108.18      [@{thm MClkReply_change} RSN (2, @{thm enabled_mono})] [] 1 *})
  108.19 -  apply (tactic {* action_simp_tac (@{simpset} addsimps
  108.20 +  apply (tactic {* action_simp_tac (@{context} addsimps
  108.21      [@{thm MClkReply_def}, @{thm Return_def}, @{thm caller_def}, @{thm rtrner_def}])
  108.22      [exI] [@{thm base_enabled}, @{thm Pair_inject}] 1 *})
  108.23    done
   109.1 --- a/src/HOL/TLA/Memory/Memory.thy	Tue Apr 16 17:54:14 2013 +0200
   109.2 +++ b/src/HOL/TLA/Memory/Memory.thy	Thu Apr 18 17:07:01 2013 +0200
   109.3 @@ -176,9 +176,9 @@
   109.4        |- Calling ch p & (rs!p ~= #NotAResult)
   109.5           --> Enabled (<MemReturn ch rs p>_(rtrner ch ! p, rs!p))"
   109.6    apply (tactic
   109.7 -    {* action_simp_tac @{simpset} [@{thm MemReturn_change} RSN (2, @{thm enabled_mono}) ] [] 1 *})
   109.8 +    {* action_simp_tac @{context} [@{thm MemReturn_change} RSN (2, @{thm enabled_mono}) ] [] 1 *})
   109.9    apply (tactic
  109.10 -    {* action_simp_tac (@{simpset} addsimps [@{thm MemReturn_def}, @{thm Return_def},
  109.11 +    {* action_simp_tac (@{context} addsimps [@{thm MemReturn_def}, @{thm Return_def},
  109.12        @{thm rtrner_def}]) [exI] [@{thm base_enabled}, @{thm Pair_inject}] 1 *})
  109.13    done
  109.14  
  109.15 @@ -222,11 +222,11 @@
  109.16           --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  109.17    apply (auto simp: enabled_disj [try_rewrite] intro!: RWRNext_enabled [temp_use])
  109.18    apply (case_tac "arg (ch w p)")
  109.19 -   apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm Read_def},
  109.20 +   apply (tactic {* action_simp_tac (@{context} addsimps [@{thm Read_def},
  109.21       temp_rewrite @{thm enabled_ex}]) [@{thm ReadInner_enabled}, exI] [] 1 *})
  109.22     apply (force dest: base_pair [temp_use])
  109.23    apply (erule contrapos_np)
  109.24 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm Write_def},
  109.25 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm Write_def},
  109.26      temp_rewrite @{thm enabled_ex}])
  109.27      [@{thm WriteInner_enabled}, exI] [] 1 *})
  109.28    done
   110.1 --- a/src/HOL/TLA/Memory/MemoryImplementation.thy	Tue Apr 16 17:54:14 2013 +0200
   110.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.thy	Thu Apr 18 17:07:01 2013 +0200
   110.3 @@ -225,13 +225,13 @@
   110.4  *)
   110.5  ML {*
   110.6    val config_fast_solver = Attrib.setup_config_bool @{binding fast_solver} (K false);
   110.7 -  val fast_solver = mk_solver "fast_solver" (fn ss =>
   110.8 -    if Config.get (Simplifier.the_context ss) config_fast_solver
   110.9 +  val fast_solver = mk_solver "fast_solver" (fn ctxt =>
  110.10 +    if Config.get ctxt config_fast_solver
  110.11      then assume_tac ORELSE' (etac notE)
  110.12      else K no_tac);
  110.13  *}
  110.14  
  110.15 -declaration {* K (Simplifier.map_ss (fn ss => ss addSSolver fast_solver)) *}
  110.16 +setup {* map_theory_simpset (fn ctxt => ctxt addSSolver fast_solver) *}
  110.17  
  110.18  ML {* val temp_elim = make_elim o temp_use *}
  110.19  
  110.20 @@ -248,9 +248,9 @@
  110.21    apply (rule historyI)
  110.22        apply assumption+
  110.23    apply (rule MI_base)
  110.24 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HInit_def}]) [] [] 1 *})
  110.25 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm HInit_def}]) [] [] 1 *})
  110.26     apply (erule fun_cong)
  110.27 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HNext_def}])
  110.28 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm HNext_def}])
  110.29      [@{thm busy_squareI}] [] 1 *})
  110.30    apply (erule fun_cong)
  110.31    done
  110.32 @@ -350,7 +350,7 @@
  110.33  
  110.34  lemma S1Hist: "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S1 rmhist p)
  110.35           --> unchanged (rmhist!p)"
  110.36 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HNext_def}, @{thm S_def},
  110.37 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm HNext_def}, @{thm S_def},
  110.38      @{thm S1_def}, @{thm MemReturn_def}, @{thm RPCFail_def}, @{thm MClkReply_def},
  110.39      @{thm Return_def}]) [] [temp_use @{thm squareE}] 1 *})
  110.40  
  110.41 @@ -366,7 +366,7 @@
  110.42  lemma S2Forward: "|- $(S2 rmhist p) & MClkFwd memCh crCh cst p
  110.43           & unchanged (e p, r p, m p, rmhist!p)
  110.44           --> (S3 rmhist p)$"
  110.45 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm MClkFwd_def},
  110.46 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm MClkFwd_def},
  110.47      @{thm Call_def}, @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def},
  110.48      @{thm rtrner_def}, @{thm S_def}, @{thm S2_def}, @{thm S3_def}, @{thm Calling_def}]) [] [] 1 *})
  110.49  
  110.50 @@ -403,7 +403,7 @@
  110.51  lemma S3Forward: "|- RPCFwd crCh rmCh rst p & HNext rmhist p & $(S3 rmhist p)
  110.52           & unchanged (e p, c p, m p)
  110.53           --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  110.54 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RPCFwd_def},
  110.55 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCFwd_def},
  110.56      @{thm HNext_def}, @{thm MemReturn_def}, @{thm RPCFail_def},
  110.57      @{thm MClkReply_def}, @{thm Return_def}, @{thm Call_def}, @{thm e_def},
  110.58      @{thm c_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm S_def},
  110.59 @@ -412,7 +412,7 @@
  110.60  lemma S3Fail: "|- RPCFail crCh rmCh rst p & $(S3 rmhist p) & HNext rmhist p
  110.61           & unchanged (e p, c p, m p)
  110.62           --> (S6 rmhist p)$"
  110.63 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HNext_def},
  110.64 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm HNext_def},
  110.65      @{thm RPCFail_def}, @{thm Return_def}, @{thm e_def}, @{thm c_def},
  110.66      @{thm m_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm MVOKBARF_def},
  110.67      @{thm S_def}, @{thm S3_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1 *})
  110.68 @@ -439,7 +439,7 @@
  110.69  lemma S4ReadInner: "|- ReadInner rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p)
  110.70           & HNext rmhist p & $(MemInv mm l)
  110.71           --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  110.72 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ReadInner_def},
  110.73 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm ReadInner_def},
  110.74      @{thm GoodRead_def}, @{thm BadRead_def}, @{thm HNext_def}, @{thm MemReturn_def},
  110.75      @{thm RPCFail_def}, @{thm MClkReply_def}, @{thm Return_def}, @{thm e_def},
  110.76      @{thm c_def}, @{thm r_def}, @{thm rtrner_def}, @{thm caller_def},
  110.77 @@ -453,7 +453,7 @@
  110.78  
  110.79  lemma S4WriteInner: "|- WriteInner rmCh mm ires p l v & $(S4 rmhist p) & unchanged (e p, c p, r p)           & HNext rmhist p
  110.80           --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  110.81 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm WriteInner_def},
  110.82 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm WriteInner_def},
  110.83      @{thm GoodWrite_def}, @{thm BadWrite_def}, @{thm HNext_def}, @{thm MemReturn_def},
  110.84      @{thm RPCFail_def}, @{thm MClkReply_def}, @{thm Return_def}, @{thm e_def},
  110.85      @{thm c_def}, @{thm r_def}, @{thm rtrner_def}, @{thm caller_def}, @{thm MVNROKBA_def},
  110.86 @@ -492,14 +492,14 @@
  110.87  
  110.88  lemma S5Reply: "|- RPCReply crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p)
  110.89         --> (S6 rmhist p)$"
  110.90 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RPCReply_def},
  110.91 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCReply_def},
  110.92      @{thm Return_def}, @{thm e_def}, @{thm c_def}, @{thm m_def}, @{thm MVOKBA_def},
  110.93      @{thm MVOKBARF_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm S_def},
  110.94      @{thm S5_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1 *})
  110.95  
  110.96  lemma S5Fail: "|- RPCFail crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p)
  110.97           --> (S6 rmhist p)$"
  110.98 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RPCFail_def},
  110.99 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCFail_def},
 110.100      @{thm Return_def}, @{thm e_def}, @{thm c_def}, @{thm m_def},
 110.101      @{thm MVOKBARF_def}, @{thm caller_def}, @{thm rtrner_def},
 110.102      @{thm S_def}, @{thm S5_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1 *})
 110.103 @@ -525,7 +525,7 @@
 110.104  lemma S6Retry: "|- MClkRetry memCh crCh cst p & HNext rmhist p & $S6 rmhist p
 110.105           & unchanged (e p,r p,m p)
 110.106           --> (S3 rmhist p)$ & unchanged (rmhist!p)"
 110.107 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HNext_def},
 110.108 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm HNext_def},
 110.109      @{thm MClkReply_def}, @{thm MClkRetry_def}, @{thm Call_def}, @{thm Return_def},
 110.110      @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def},
 110.111      @{thm S_def}, @{thm S6_def}, @{thm S3_def}, @{thm Calling_def}]) [] [] 1 *})
 110.112 @@ -533,7 +533,7 @@
 110.113  lemma S6Reply: "|- MClkReply memCh crCh cst p & HNext rmhist p & $S6 rmhist p
 110.114           & unchanged (e p,r p,m p)
 110.115           --> (S1 rmhist p)$"
 110.116 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm HNext_def},
 110.117 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm HNext_def},
 110.118      @{thm MemReturn_def}, @{thm RPCFail_def}, @{thm Return_def}, @{thm MClkReply_def},
 110.119      @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def},
 110.120      @{thm S_def}, @{thm S6_def}, @{thm S1_def}, @{thm Calling_def}]) [] [] 1 *})
 110.121 @@ -565,7 +565,7 @@
 110.122  lemma Step1_2_1: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
 110.123           & ~unchanged (e p, c p, r p, m p, rmhist!p)  & $S1 rmhist p
 110.124           --> (S2 rmhist p)$ & ENext p & unchanged (c p, r p, m p)"
 110.125 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.126 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.127        (map temp_elim [@{thm S1ClerkUnch}, @{thm S1RPCUnch}, @{thm S1MemUnch}, @{thm S1Hist}]) 1 *})
 110.128     using [[fast_solver]]
 110.129     apply (auto elim!: squareE [temp_use] intro!: S1Env [temp_use])
 110.130 @@ -575,7 +575,7 @@
 110.131           & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S2 rmhist p
 110.132           --> (S3 rmhist p)$ & MClkFwd memCh crCh cst p
 110.133               & unchanged (e p, r p, m p, rmhist!p)"
 110.134 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.135 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.136      (map temp_elim [@{thm S2EnvUnch}, @{thm S2RPCUnch}, @{thm S2MemUnch}, @{thm S2Hist}]) 1 *})
 110.137     using [[fast_solver]]
 110.138     apply (auto elim!: squareE [temp_use] intro!: S2Clerk [temp_use] S2Forward [temp_use])
 110.139 @@ -585,9 +585,9 @@
 110.140           & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S3 rmhist p
 110.141           --> ((S4 rmhist p)$ & RPCFwd crCh rmCh rst p & unchanged (e p, c p, m p, rmhist!p))
 110.142               | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
 110.143 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.144 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.145      (map temp_elim [@{thm S3EnvUnch}, @{thm S3ClerkUnch}, @{thm S3MemUnch}]) 1 *})
 110.146 -  apply (tactic {* action_simp_tac @{simpset} []
 110.147 +  apply (tactic {* action_simp_tac @{context} []
 110.148      (@{thm squareE} :: map temp_elim [@{thm S3RPC}, @{thm S3Forward}, @{thm S3Fail}]) 1 *})
 110.149     apply (auto dest!: S3Hist [temp_use])
 110.150    done
 110.151 @@ -598,9 +598,9 @@
 110.152           --> ((S4 rmhist p)$ & Read rmCh mm ires p & unchanged (e p, c p, r p, rmhist!p))
 110.153               | ((S4 rmhist p)$ & (? l. Write rmCh mm ires p l) & unchanged (e p, c p, r p, rmhist!p))
 110.154               | ((S5 rmhist p)$ & MemReturn rmCh ires p & unchanged (e p, c p, r p))"
 110.155 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.156 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.157      (map temp_elim [@{thm S4EnvUnch}, @{thm S4ClerkUnch}, @{thm S4RPCUnch}]) 1 *})
 110.158 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RNext_def}]) []
 110.159 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm RNext_def}]) []
 110.160      (@{thm squareE} :: map temp_elim [@{thm S4Read}, @{thm S4Write}, @{thm S4Return}]) 1 *})
 110.161    apply (auto dest!: S4Hist [temp_use])
 110.162    done
 110.163 @@ -609,9 +609,9 @@
 110.164                & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S5 rmhist p
 110.165           --> ((S6 rmhist p)$ & RPCReply crCh rmCh rst p & unchanged (e p, c p, m p))
 110.166               | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
 110.167 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.168 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.169      (map temp_elim [@{thm S5EnvUnch}, @{thm S5ClerkUnch}, @{thm S5MemUnch}, @{thm S5Hist}]) 1 *})
 110.170 -  apply (tactic {* action_simp_tac @{simpset} [] [@{thm squareE}, temp_elim @{thm S5RPC}] 1 *})
 110.171 +  apply (tactic {* action_simp_tac @{context} [] [@{thm squareE}, temp_elim @{thm S5RPC}] 1 *})
 110.172     using [[fast_solver]]
 110.173     apply (auto elim!: squareE [temp_use] dest!: S5Reply [temp_use] S5Fail [temp_use])
 110.174    done
 110.175 @@ -620,9 +620,9 @@
 110.176                & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S6 rmhist p
 110.177           --> ((S1 rmhist p)$ & MClkReply memCh crCh cst p & unchanged (e p, r p, m p))
 110.178               | ((S3 rmhist p)$ & MClkRetry memCh crCh cst p & unchanged (e p,r p,m p,rmhist!p))"
 110.179 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ImpNext_def}]) []
 110.180 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ImpNext_def}]) []
 110.181      (map temp_elim [@{thm S6EnvUnch}, @{thm S6RPCUnch}, @{thm S6MemUnch}]) 1 *})
 110.182 -  apply (tactic {* action_simp_tac @{simpset} []
 110.183 +  apply (tactic {* action_simp_tac @{context} []
 110.184      (@{thm squareE} :: map temp_elim [@{thm S6Clerk}, @{thm S6Retry}, @{thm S6Reply}]) 1 *})
 110.185       apply (auto dest: S6Hist [temp_use])
 110.186    done
 110.187 @@ -634,7 +634,7 @@
 110.188  section "Initialization (Step 1.3)"
 110.189  
 110.190  lemma Step1_3: "|- S1 rmhist p --> PInit (resbar rmhist) p"
 110.191 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm resbar_def},
 110.192 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm resbar_def},
 110.193      @{thm PInit_def}, @{thm S_def}, @{thm S1_def}]) [] [] 1 *})
 110.194  
 110.195  (* ----------------------------------------------------------------------
 110.196 @@ -653,7 +653,7 @@
 110.197           & unchanged (e p, r p, m p, rmhist!p)
 110.198           --> unchanged (rtrner memCh!p, resbar rmhist!p)"
 110.199    by (tactic {* action_simp_tac
 110.200 -    (@{simpset} addsimps [@{thm MClkFwd_def}, @{thm e_def}, @{thm r_def}, @{thm m_def},
 110.201 +    (@{context} addsimps [@{thm MClkFwd_def}, @{thm e_def}, @{thm r_def}, @{thm m_def},
 110.202      @{thm resbar_def}, @{thm S_def}, @{thm S2_def}, @{thm S3_def}]) [] [] 1 *})
 110.203  
 110.204  lemma Step1_4_3a: "|- RPCFwd crCh rmCh rst p & $S3 rmhist p & (S4 rmhist p)$
 110.205 @@ -661,7 +661,7 @@
 110.206           --> unchanged (rtrner memCh!p, resbar rmhist!p)"
 110.207    apply clarsimp
 110.208    apply (drule S3_excl [temp_use] S4_excl [temp_use])+
 110.209 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm e_def},
 110.210 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm e_def},
 110.211      @{thm c_def}, @{thm m_def}, @{thm resbar_def}, @{thm S_def}, @{thm S3_def}]) [] [] 1 *})
 110.212    done
 110.213  
 110.214 @@ -680,11 +680,11 @@
 110.215           --> ReadInner memCh mm (resbar rmhist) p l"
 110.216    apply clarsimp
 110.217    apply (drule S4_excl [temp_use])+
 110.218 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm ReadInner_def},
 110.219 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm ReadInner_def},
 110.220      @{thm GoodRead_def}, @{thm BadRead_def}, @{thm e_def}, @{thm c_def}, @{thm m_def}]) [] [] 1 *})
 110.221       apply (auto simp: resbar_def)
 110.222         apply (tactic {* ALLGOALS (action_simp_tac
 110.223 -                (@{simpset} addsimps [@{thm RPCRelayArg_def}, @{thm MClkRelayArg_def},
 110.224 +                (@{context} addsimps [@{thm RPCRelayArg_def}, @{thm MClkRelayArg_def},
 110.225                    @{thm S_def}, @{thm S4_def}, @{thm RdRequest_def}, @{thm MemInv_def}])
 110.226                  [] [@{thm impE}, @{thm MemValNotAResultE}]) *})
 110.227    done
 110.228 @@ -699,11 +699,11 @@
 110.229           --> WriteInner memCh mm (resbar rmhist) p l v"
 110.230    apply clarsimp
 110.231    apply (drule S4_excl [temp_use])+
 110.232 -  apply (tactic {* action_simp_tac (@{simpset} addsimps
 110.233 +  apply (tactic {* action_simp_tac (@{context} addsimps
 110.234      [@{thm WriteInner_def}, @{thm GoodWrite_def}, @{thm BadWrite_def}, @{thm e_def},
 110.235      @{thm c_def}, @{thm m_def}]) [] [] 1 *})
 110.236       apply (auto simp: resbar_def)
 110.237 -    apply (tactic {* ALLGOALS (action_simp_tac (@{simpset} addsimps
 110.238 +    apply (tactic {* ALLGOALS (action_simp_tac (@{context} addsimps
 110.239        [@{thm RPCRelayArg_def}, @{thm MClkRelayArg_def}, @{thm S_def},
 110.240        @{thm S4_def}, @{thm WrRequest_def}]) [] []) *})
 110.241    done
 110.242 @@ -716,7 +716,7 @@
 110.243  lemma Step1_4_4c: "|- MemReturn rmCh ires p & $S4 rmhist p & (S5 rmhist p)$
 110.244           & unchanged (e p, c p, r p)
 110.245           --> unchanged (rtrner memCh!p, resbar rmhist!p)"
 110.246 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm e_def},
 110.247 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm e_def},
 110.248      @{thm c_def}, @{thm r_def}, @{thm resbar_def}]) [] [] 1 *})
 110.249    apply (drule S4_excl [temp_use] S5_excl [temp_use])+
 110.250    using [[fast_solver]]
 110.251 @@ -746,11 +746,11 @@
 110.252           --> MemReturn memCh (resbar rmhist) p"
 110.253    apply clarsimp
 110.254    apply (drule S6_excl [temp_use])+
 110.255 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm e_def},
 110.256 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm e_def},
 110.257      @{thm r_def}, @{thm m_def}, @{thm MClkReply_def}, @{thm MemReturn_def},
 110.258      @{thm Return_def}, @{thm resbar_def}]) [] [] 1 *})
 110.259      apply simp_all (* simplify if-then-else *)
 110.260 -    apply (tactic {* ALLGOALS (action_simp_tac (@{simpset} addsimps
 110.261 +    apply (tactic {* ALLGOALS (action_simp_tac (@{context} addsimps
 110.262        [@{thm MClkReplyVal_def}, @{thm S6_def}, @{thm S_def}]) [] [@{thm MVOKBARFnotNR}]) *})
 110.263    done
 110.264  
 110.265 @@ -759,7 +759,7 @@
 110.266           --> MemFail memCh (resbar rmhist) p"
 110.267    apply clarsimp
 110.268    apply (drule S3_excl [temp_use])+
 110.269 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm e_def}, @{thm r_def},
 110.270 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm e_def}, @{thm r_def},
 110.271      @{thm m_def}, @{thm MClkRetry_def}, @{thm MemFail_def}, @{thm resbar_def}]) [] [] 1 *})
 110.272     apply (auto simp: S6_def S_def)
 110.273    done
 110.274 @@ -797,7 +797,7 @@
 110.275      Induct_Tacs.case_tac ctxt "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" 1 THEN
 110.276      rewrite_goals_tac @{thms action_rews} THEN
 110.277      forward_tac [temp_use @{thm Step1_4_7}] 1 THEN
 110.278 -    asm_full_simp_tac (simpset_of ctxt) 1);
 110.279 +    asm_full_simp_tac ctxt 1);
 110.280  *}
 110.281  
 110.282  method_setup split_idle = {*
 110.283 @@ -897,14 +897,14 @@
 110.284  
 110.285  lemma S1_RNextdisabled: "|- S1 rmhist p -->
 110.286           ~Enabled (<RNext memCh mm (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
 110.287 -  apply (tactic {* action_simp_tac (@{simpset} addsimps [@{thm angle_def},
 110.288 +  apply (tactic {* action_simp_tac (@{context} addsimps [@{thm angle_def},
 110.289      @{thm S_def}, @{thm S1_def}]) [notI] [@{thm enabledE}, temp_elim @{thm Memoryidle}] 1 *})
 110.290    apply force
 110.291    done
 110.292  
 110.293  lemma S1_Returndisabled: "|- S1 rmhist p -->
 110.294           ~Enabled (<MemReturn memCh (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
 110.295 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm angle_def}, @{thm MemReturn_def},
 110.296 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm angle_def}, @{thm MemReturn_def},
 110.297      @{thm Return_def}, @{thm S_def}, @{thm S1_def}]) [notI] [@{thm enabledE}] 1 *})
 110.298  
 110.299  lemma RNext_fair: "|- []<>S1 rmhist p
 110.300 @@ -1083,7 +1083,7 @@
 110.301  
 110.302  lemma MClkReplyS6:
 110.303    "|- $ImpInv rmhist p & <MClkReply memCh crCh cst p>_(c p) --> $S6 rmhist p"
 110.304 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm angle_def},
 110.305 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm angle_def},
 110.306      @{thm MClkReply_def}, @{thm Return_def}, @{thm ImpInv_def}, @{thm S_def},
 110.307      @{thm S1_def}, @{thm S2_def}, @{thm S3_def}, @{thm S4_def}, @{thm S5_def}]) [] [] 1 *})
 110.308  
 110.309 @@ -1091,7 +1091,7 @@
 110.310    apply (auto simp: c_def intro!: MClkReply_enabled [temp_use])
 110.311       apply (cut_tac MI_base)
 110.312       apply (blast dest: base_pair)
 110.313 -    apply (tactic {* ALLGOALS (action_simp_tac (@{simpset}
 110.314 +    apply (tactic {* ALLGOALS (action_simp_tac (@{context}
 110.315        addsimps [@{thm S_def}, @{thm S6_def}]) [] []) *})
 110.316    done
 110.317  
 110.318 @@ -1102,7 +1102,7 @@
 110.319    apply (subgoal_tac "sigma |= []<> (<MClkReply memCh crCh cst p>_ (c p))")
 110.320     apply (erule InfiniteEnsures)
 110.321      apply assumption
 110.322 -   apply (tactic {* action_simp_tac @{simpset} []
 110.323 +   apply (tactic {* action_simp_tac @{context} []
 110.324       (map temp_elim [@{thm MClkReplyS6}, @{thm S6MClkReply_successors}]) 1 *})
 110.325    apply (auto simp: SF_def)
 110.326    apply (erule contrapos_np)
 110.327 @@ -1189,7 +1189,7 @@
 110.328           sigma |= []<>S6 rmhist p --> []<>S1 rmhist p |]
 110.329        ==> sigma |= []<>S1 rmhist p"
 110.330    apply (rule classical)
 110.331 -  apply (tactic {* asm_lr_simp_tac (@{simpset} addsimps
 110.332 +  apply (tactic {* asm_lr_simp_tac (@{context} addsimps
 110.333      [temp_use @{thm NotBox}, temp_rewrite @{thm NotDmd}]) 1 *})
 110.334    apply (auto elim!: leadsto_infinite [temp_use] mp dest!: DBImplBD [temp_use])
 110.335    done
   111.1 --- a/src/HOL/TLA/Memory/RPC.thy	Tue Apr 16 17:54:14 2013 +0200
   111.2 +++ b/src/HOL/TLA/Memory/RPC.thy	Thu Apr 18 17:07:01 2013 +0200
   111.3 @@ -99,14 +99,14 @@
   111.4  (* Enabledness of some actions *)
   111.5  lemma RPCFail_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>  
   111.6      |- ~Calling rcv p & Calling send p --> Enabled (RPCFail send rcv rst p)"
   111.7 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RPCFail_def},
   111.8 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCFail_def},
   111.9      @{thm Return_def}, @{thm caller_def}, @{thm rtrner_def}]) [exI]
  111.10      [@{thm base_enabled}, @{thm Pair_inject}] 1 *})
  111.11  
  111.12  lemma RPCReply_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>  
  111.13        |- ~Calling rcv p & Calling send p & rst!p = #rpcB  
  111.14           --> Enabled (RPCReply send rcv rst p)"
  111.15 -  by (tactic {* action_simp_tac (@{simpset} addsimps [@{thm RPCReply_def},
  111.16 +  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCReply_def},
  111.17      @{thm Return_def}, @{thm caller_def}, @{thm rtrner_def}]) [exI]
  111.18      [@{thm base_enabled}, @{thm Pair_inject}] 1 *})
  111.19  
   112.1 --- a/src/HOL/TLA/TLA.thy	Tue Apr 16 17:54:14 2013 +0200
   112.2 +++ b/src/HOL/TLA/TLA.thy	Thu Apr 18 17:07:01 2013 +0200
   112.3 @@ -597,7 +597,7 @@
   112.4    SELECT_GOAL
   112.5      (inv_tac ctxt 1 THEN
   112.6        (TRYALL (action_simp_tac
   112.7 -        (simpset_of ctxt addsimps [@{thm Init_stp}, @{thm Init_act}]) [] [@{thm squareE}])));
   112.8 +        (ctxt addsimps [@{thm Init_stp}, @{thm Init_act}]) [] [@{thm squareE}])));
   112.9  *}
  112.10  
  112.11  method_setup invariant = {*
   113.1 --- a/src/HOL/TPTP/atp_problem_import.ML	Tue Apr 16 17:54:14 2013 +0200
   113.2 +++ b/src/HOL/TPTP/atp_problem_import.ML	Thu Apr 18 17:07:01 2013 +0200
   113.3 @@ -234,7 +234,7 @@
   113.4    SOLVE_TIMEOUT (timeout div 20) "nitpick"
   113.5        (nitpick_finite_oracle_tac ctxt (timeout div 20) i)
   113.6    ORELSE SOLVE_TIMEOUT (timeout div 10) "simp"
   113.7 -      (asm_full_simp_tac (simpset_of ctxt) i)
   113.8 +      (asm_full_simp_tac ctxt i)
   113.9    ORELSE SOLVE_TIMEOUT (timeout div 10) "blast" (blast_tac ctxt i)
  113.10    ORELSE SOLVE_TIMEOUT (timeout div 5) "auto+spass"
  113.11        (auto_tac ctxt
   114.1 --- a/src/HOL/Tools/ATP/atp_problem_generate.ML	Tue Apr 16 17:54:14 2013 +0200
   114.2 +++ b/src/HOL/Tools/ATP/atp_problem_generate.ML	Thu Apr 18 17:07:01 2013 +0200
   114.3 @@ -1230,10 +1230,10 @@
   114.4        | _ => do_term bs t
   114.5    in do_formula [] end
   114.6  
   114.7 -fun presimplify_term thy t =
   114.8 +fun presimplify_term ctxt t =
   114.9    if exists_Const (member (op =) Meson.presimplified_consts o fst) t then
  114.10 -    t |> Skip_Proof.make_thm thy
  114.11 -      |> Meson.presimplify
  114.12 +    t |> Skip_Proof.make_thm (Proof_Context.theory_of ctxt)
  114.13 +      |> Meson.presimplify ctxt
  114.14        |> prop_of
  114.15    else
  114.16      t
  114.17 @@ -1273,7 +1273,7 @@
  114.18      t |> need_trueprop ? HOLogic.mk_Trueprop
  114.19        |> (if is_ho then unextensionalize_def
  114.20            else cong_extensionalize_term thy #> abs_extensionalize_term ctxt)
  114.21 -      |> presimplify_term thy
  114.22 +      |> presimplify_term ctxt
  114.23        |> HOLogic.dest_Trueprop
  114.24    end
  114.25    handle TERM _ => @{const True}
   115.1 --- a/src/HOL/Tools/Datatype/datatype.ML	Tue Apr 16 17:54:14 2013 +0200
   115.2 +++ b/src/HOL/Tools/Datatype/datatype.ML	Thu Apr 18 17:07:01 2013 +0200
   115.3 @@ -537,8 +537,8 @@
   115.4          fun prove [] = []
   115.5            | prove (t :: ts) =
   115.6                let
   115.7 -                val dist_thm = Goal.prove_sorry_global thy5 [] [] t (fn _ =>
   115.8 -                  EVERY [simp_tac (HOL_ss addsimps dist_rewrites') 1])
   115.9 +                val dist_thm = Goal.prove_sorry_global thy5 [] [] t (fn {context = ctxt, ...} =>
  115.10 +                  EVERY [simp_tac (put_simpset HOL_ss ctxt addsimps dist_rewrites') 1])
  115.11                in dist_thm :: Drule.zero_var_indexes (dist_thm RS not_sym) :: prove ts end;
  115.12        in prove end;
  115.13  
  115.14 @@ -632,13 +632,14 @@
  115.15        Goal.prove_sorry_global thy6 []
  115.16        (Logic.strip_imp_prems dt_induct_prop)
  115.17        (Logic.strip_imp_concl dt_induct_prop)
  115.18 -      (fn {prems, ...} =>
  115.19 +      (fn {context = ctxt, prems, ...} =>
  115.20          EVERY
  115.21            [rtac indrule_lemma' 1,
  115.22             (Datatype_Aux.ind_tac rep_induct [] THEN_ALL_NEW Object_Logic.atomize_prems_tac) 1,
  115.23             EVERY (map (fn (prem, r) => (EVERY
  115.24               [REPEAT (eresolve_tac Abs_inverse_thms 1),
  115.25 -              simp_tac (HOL_basic_ss addsimps (Thm.symmetric r :: Rep_inverse_thms')) 1,
  115.26 +              simp_tac (put_simpset HOL_basic_ss ctxt
  115.27 +                addsimps (Thm.symmetric r :: Rep_inverse_thms')) 1,
  115.28                DEPTH_SOLVE_1 (ares_tac [prem] 1 ORELSE etac allE 1)]))
  115.29                    (prems ~~ (constr_defs @ map mk_meta_eq iso_char_thms)))]);
  115.30  
   116.1 --- a/src/HOL/Tools/Datatype/datatype_codegen.ML	Tue Apr 16 17:54:14 2013 +0200
   116.2 +++ b/src/HOL/Tools/Datatype/datatype_codegen.ML	Thu Apr 18 17:07:01 2013 +0200
   116.3 @@ -81,12 +81,11 @@
   116.4        [trueprop $ false_eq (t1, t2), trueprop $ false_eq (t2, t1)];
   116.5      val distincts = maps prep_distinct (nth (Datatype_Prop.make_distincts [descr]) index);
   116.6      val refl = HOLogic.mk_Trueprop (true_eq (Free ("x", ty), Free ("x", ty)));
   116.7 -    val simpset =
   116.8 -      Simplifier.global_context thy
   116.9 -        (HOL_basic_ss addsimps
  116.10 -          (map Simpdata.mk_eq (@{thms equal eq_True} @ inject_thms @ distinct_thms)));
  116.11 +    val simp_ctxt =
  116.12 +      Simplifier.global_context thy HOL_basic_ss
  116.13 +        addsimps (map Simpdata.mk_eq (@{thms equal eq_True} @ inject_thms @ distinct_thms));
  116.14      fun prove prop =
  116.15 -      Goal.prove_sorry_global thy [] [] prop (K (ALLGOALS (simp_tac simpset)))
  116.16 +      Goal.prove_sorry_global thy [] [] prop (K (ALLGOALS (simp_tac simp_ctxt)))
  116.17        |> Simpdata.mk_eq;
  116.18    in (map prove (triv_injects @ injects @ distincts), prove refl) end;
  116.19  
   117.1 --- a/src/HOL/Tools/Datatype/datatype_realizer.ML	Tue Apr 16 17:54:14 2013 +0200
   117.2 +++ b/src/HOL/Tools/Datatype/datatype_realizer.ML	Thu Apr 18 17:07:01 2013 +0200
   117.3 @@ -192,8 +192,8 @@
   117.4             EVERY [
   117.5              rtac (cterm_instantiate [(cert y, cert y')] exhaust) 1,
   117.6              ALLGOALS (EVERY'
   117.7 -              [asm_simp_tac (HOL_basic_ss addsimps case_rewrites),
   117.8 -               resolve_tac prems, asm_simp_tac HOL_basic_ss])])
   117.9 +              [asm_simp_tac (Simplifier.global_context thy HOL_basic_ss addsimps case_rewrites),
  117.10 +               resolve_tac prems, asm_simp_tac (Simplifier.global_context thy HOL_basic_ss)])])
  117.11        |> Drule.export_without_context;
  117.12  
  117.13      val exh_name = Thm.derivation_name exhaust;
   118.1 --- a/src/HOL/Tools/Datatype/rep_datatype.ML	Tue Apr 16 17:54:14 2013 +0200
   118.2 +++ b/src/HOL/Tools/Datatype/rep_datatype.ML	Thu Apr 18 17:07:01 2013 +0200
   118.3 @@ -156,12 +156,12 @@
   118.4  
   118.5      val _ = Datatype_Aux.message config "Proving termination and uniqueness of primrec functions ...";
   118.6  
   118.7 -    fun mk_unique_tac ((((i, (tname, _, constrs)), elim), T), T') (tac, intrs) =
   118.8 +    fun mk_unique_tac ctxt ((((i, (tname, _, constrs)), elim), T), T') (tac, intrs) =
   118.9        let
  118.10          val distinct_tac =
  118.11            if i < length newTs then
  118.12 -            full_simp_tac (HOL_ss addsimps (nth dist_rewrites i)) 1
  118.13 -          else full_simp_tac (HOL_ss addsimps (flat other_dist_rewrites)) 1;
  118.14 +            full_simp_tac (put_simpset HOL_ss ctxt addsimps (nth dist_rewrites i)) 1
  118.15 +          else full_simp_tac (put_simpset HOL_ss ctxt addsimps (flat other_dist_rewrites)) 1;
  118.16  
  118.17          val inject =
  118.18            map (fn r => r RS iffD1)
  118.19 @@ -203,13 +203,13 @@
  118.20            map (fn ((i, T), t) => absfree ("x" ^ string_of_int i, T) t)
  118.21              ((1 upto length recTs) ~~ recTs ~~ rec_unique_ts);
  118.22          val induct' = cterm_instantiate (map cert induct_Ps ~~ map cert insts) induct;
  118.23 -        val (tac, _) =
  118.24 -          fold mk_unique_tac (descr' ~~ rec_elims ~~ recTs ~~ rec_result_Ts)
  118.25 -            (((rtac induct' THEN_ALL_NEW Object_Logic.atomize_prems_tac) 1 THEN
  118.26 -                rewrite_goals_tac [mk_meta_eq @{thm choice_eq}], rec_intrs));
  118.27        in
  118.28          Datatype_Aux.split_conj_thm (Goal.prove_sorry_global thy1 [] []
  118.29 -          (HOLogic.mk_Trueprop (Datatype_Aux.mk_conj rec_unique_ts)) (K tac))
  118.30 +          (HOLogic.mk_Trueprop (Datatype_Aux.mk_conj rec_unique_ts))
  118.31 +          (fn {context = ctxt, ...} =>
  118.32 +            #1 (fold (mk_unique_tac ctxt) (descr' ~~ rec_elims ~~ recTs ~~ rec_result_Ts)
  118.33 +              (((rtac induct' THEN_ALL_NEW Object_Logic.atomize_prems_tac) 1 THEN
  118.34 +                  rewrite_goals_tac [mk_meta_eq @{thm choice_eq}], rec_intrs)))))
  118.35        end;
  118.36  
  118.37      val rec_total_thms = map (fn r => r RS @{thm theI'}) rec_unique_thms;
  118.38 @@ -359,12 +359,13 @@
  118.39          val cert = cterm_of thy;
  118.40          val _ $ (_ $ lhs $ _) = hd (Logic.strip_assums_hyp (hd (prems_of exhaustion)));
  118.41          val exhaustion' = cterm_instantiate [(cert lhs, cert (Free ("x", T)))] exhaustion;
  118.42 -        val tac =
  118.43 +        fun tac ctxt =
  118.44            EVERY [rtac exhaustion' 1,
  118.45 -            ALLGOALS (asm_simp_tac (HOL_ss addsimps (dist_rewrites' @ inject @ case_thms')))];
  118.46 +            ALLGOALS (asm_simp_tac
  118.47 +              (put_simpset HOL_ss ctxt addsimps (dist_rewrites' @ inject @ case_thms')))];
  118.48        in
  118.49 -        (Goal.prove_sorry_global thy [] [] t1 (K tac),
  118.50 -         Goal.prove_sorry_global thy [] [] t2 (K tac))
  118.51 +        (Goal.prove_sorry_global thy [] [] t1 (tac o #context),
  118.52 +         Goal.prove_sorry_global thy [] [] t2 (tac o #context))
  118.53        end;
  118.54  
  118.55      val split_thm_pairs =
  118.56 @@ -429,10 +430,12 @@
  118.57          val nchotomy'' = cterm_instantiate [(cert (Var v), cert Ma)] nchotomy';
  118.58        in
  118.59          Goal.prove_sorry_global thy [] (Logic.strip_imp_prems t) (Logic.strip_imp_concl t)
  118.60 -          (fn {prems, ...} =>
  118.61 -            let val simplify = asm_simp_tac (HOL_ss addsimps (prems @ case_rewrites)) in
  118.62 +          (fn {context = ctxt, prems, ...} =>
  118.63 +            let
  118.64 +              val simplify = asm_simp_tac (put_simpset HOL_ss ctxt addsimps (prems @ case_rewrites))
  118.65 +            in
  118.66                EVERY [
  118.67 -                simp_tac (HOL_ss addsimps [hd prems]) 1,
  118.68 +                simp_tac (put_simpset HOL_ss ctxt addsimps [hd prems]) 1,
  118.69                  cut_tac nchotomy'' 1,
  118.70                  REPEAT (etac disjE 1 THEN REPEAT (etac exE 1) THEN simplify 1),
  118.71                  REPEAT (etac exE 1) THEN simplify 1 (* Get last disjunct *)]
   119.1 --- a/src/HOL/Tools/Function/context_tree.ML	Tue Apr 16 17:54:14 2013 +0200
   119.2 +++ b/src/HOL/Tools/Function/context_tree.ML	Thu Apr 18 17:07:01 2013 +0200
   119.3 @@ -33,7 +33,7 @@
   119.4     (ctxt * thm) list * 'b)
   119.5     -> ctx_tree -> 'b -> 'b
   119.6  
   119.7 -  val rewrite_by_tree : theory -> term -> thm -> (thm * thm) list ->
   119.8 +  val rewrite_by_tree : Proof.context -> term -> thm -> (thm * thm) list ->
   119.9      ctx_tree -> thm * (thm * thm) list
  119.10  end
  119.11  
  119.12 @@ -240,8 +240,9 @@
  119.13      snd o traverse_help ([], []) tr []
  119.14    end
  119.15  
  119.16 -fun rewrite_by_tree thy h ih x tr =
  119.17 +fun rewrite_by_tree ctxt h ih x tr =
  119.18    let
  119.19 +    val thy = Proof_Context.theory_of ctxt
  119.20      fun rewrite_help _ _ x (Leaf t) = (Thm.reflexive (cterm_of thy t), x)
  119.21        | rewrite_help fix h_as x (RCall (_ $ arg, st)) =
  119.22          let
  119.23 @@ -268,7 +269,7 @@
  119.24                  |> map (fn u_eq => (u_eq RS sym) RS eq_reflection)
  119.25                  |> filter_out Thm.is_reflexive
  119.26  
  119.27 -              val assumes' = map (simplify (HOL_basic_ss addsimps used)) assumes
  119.28 +              val assumes' = map (simplify (put_simpset HOL_basic_ss  ctxt addsimps used)) assumes
  119.29  
  119.30                val (subeq, x') =
  119.31                  rewrite_help (fix @ fixes) (h_as @ assumes') x st
   120.1 --- a/src/HOL/Tools/Function/function.ML	Tue Apr 16 17:54:14 2013 +0200
   120.2 +++ b/src/HOL/Tools/Function/function.ML	Thu Apr 18 17:07:01 2013 +0200
   120.3 @@ -187,7 +187,8 @@
   120.4        let
   120.5          val totality = Thm.close_derivation totality
   120.6          val remove_domain_condition =
   120.7 -          full_simplify (HOL_basic_ss addsimps [totality, @{thm True_implies_equals}])
   120.8 +          full_simplify (put_simpset HOL_basic_ss lthy
   120.9 +            addsimps [totality, @{thm True_implies_equals}])
  120.10          val tsimps = map remove_domain_condition psimps
  120.11          val tinduct = map remove_domain_condition pinducts
  120.12  
   121.1 --- a/src/HOL/Tools/Function/function_core.ML	Tue Apr 16 17:54:14 2013 +0200
   121.2 +++ b/src/HOL/Tools/Function/function_core.ML	Thu Apr 18 17:07:01 2013 +0200
   121.3 @@ -260,8 +260,9 @@
   121.4    end
   121.5  
   121.6  (* Generates the replacement lemma in fully quantified form. *)
   121.7 -fun mk_replacement_lemma thy h ih_elim clause =
   121.8 +fun mk_replacement_lemma ctxt h ih_elim clause =
   121.9    let
  121.10 +    val thy = Proof_Context.theory_of ctxt
  121.11      val ClauseInfo {cdata=ClauseContext {qs, lhs, cqs, ags, case_hyp, ...},
  121.12        RCs, tree, ...} = clause
  121.13      local open Conv in
  121.14 @@ -276,7 +277,7 @@
  121.15        Thm.assume (cterm_of thy (subst_bounds (rev qs, h_assum)))) RCs
  121.16  
  121.17      val (eql, _) =
  121.18 -      Function_Ctx_Tree.rewrite_by_tree thy h ih_elim_case (Ris ~~ h_assums) tree
  121.19 +      Function_Ctx_Tree.rewrite_by_tree ctxt h ih_elim_case (Ris ~~ h_assums) tree
  121.20  
  121.21      val replace_lemma = (eql RS meta_eq_to_obj_eq)
  121.22        |> Thm.implies_intr (cprop_of case_hyp)
  121.23 @@ -328,13 +329,14 @@
  121.24  
  121.25  
  121.26  
  121.27 -fun mk_uniqueness_case thy globals G f ihyp ih_intro G_cases compat_store clauses rep_lemmas clausei =
  121.28 +fun mk_uniqueness_case ctxt globals G f ihyp ih_intro G_cases compat_store clauses rep_lemmas clausei =
  121.29    let
  121.30 +    val thy = Proof_Context.theory_of ctxt
  121.31      val Globals {x, y, ranT, fvar, ...} = globals
  121.32      val ClauseInfo {cdata = ClauseContext {lhs, rhs, cqs, ags, case_hyp, ...}, lGI, RCs, ...} = clausei
  121.33      val rhsC = Pattern.rewrite_term thy [(fvar, f)] [] rhs
  121.34  
  121.35 -    val ih_intro_case = full_simplify (HOL_basic_ss addsimps [case_hyp]) ih_intro
  121.36 +    val ih_intro_case = full_simplify (put_simpset HOL_basic_ss ctxt addsimps [case_hyp]) ih_intro
  121.37  
  121.38      fun prep_RC (RCInfo {llRI, RIvs, CCas, ...}) = (llRI RS ih_intro_case)
  121.39        |> fold_rev (Thm.implies_intr o cprop_of) CCas
  121.40 @@ -366,7 +368,7 @@
  121.41        ex1I |> instantiate' [SOME (ctyp_of thy ranT)] [SOME P2, SOME (cterm_of thy rhsC)]
  121.42        |> curry (op COMP) existence
  121.43        |> curry (op COMP) uniqueness
  121.44 -      |> simplify (HOL_basic_ss addsimps [case_hyp RS sym])
  121.45 +      |> simplify (put_simpset HOL_basic_ss ctxt addsimps [case_hyp RS sym])
  121.46        |> Thm.implies_intr (cprop_of case_hyp)
  121.47        |> fold_rev (Thm.implies_intr o cprop_of) ags
  121.48        |> fold_rev Thm.forall_intr cqs
  121.49 @@ -401,11 +403,14 @@
  121.50        |> instantiate' [] [NONE, SOME (cterm_of thy h)]
  121.51  
  121.52      val _ = trace_msg (K "Proving Replacement lemmas...")
  121.53 -    val repLemmas = map (mk_replacement_lemma thy h ih_elim) clauses
  121.54 +    val repLemmas = map (mk_replacement_lemma ctxt h ih_elim) clauses
  121.55  
  121.56      val _ = trace_msg (K "Proving cases for unique existence...")
  121.57      val (ex1s, values) =
  121.58 -      split_list (map (mk_uniqueness_case thy globals G f ihyp ih_intro G_elim compat_store clauses repLemmas) clauses)
  121.59 +      split_list
  121.60 +        (map
  121.61 +          (mk_uniqueness_case ctxt globals G f ihyp ih_intro G_elim compat_store clauses repLemmas)
  121.62 +          clauses)
  121.63  
  121.64      val _ = trace_msg (K "Proving: Graph is a function")
  121.65      val graph_is_function = complete
  121.66 @@ -551,8 +556,9 @@
  121.67   *                   PROVING THE RULES
  121.68   **********************************************************)
  121.69  
  121.70 -fun mk_psimps thy globals R clauses valthms f_iff graph_is_function =
  121.71 +fun mk_psimps ctxt globals R clauses valthms f_iff graph_is_function =
  121.72    let
  121.73 +    val thy = Proof_Context.theory_of ctxt
  121.74      val Globals {domT, z, ...} = globals
  121.75  
  121.76      fun mk_psimp (ClauseInfo {qglr = (oqs, _, _, _), cdata = ClauseContext {cqs, lhs, ags, ...}, ...}) valthm =
  121.77 @@ -566,7 +572,7 @@
  121.78          |> Thm.forall_intr (cterm_of thy z)
  121.79          |> (fn it => it COMP valthm)
  121.80          |> Thm.implies_intr lhs_acc
  121.81 -        |> asm_simplify (HOL_basic_ss addsimps [f_iff])
  121.82 +        |> asm_simplify (put_simpset HOL_basic_ss ctxt addsimps [f_iff])
  121.83          |> fold_rev (Thm.implies_intr o cprop_of) ags
  121.84          |> fold_rev forall_intr_rename (map fst oqs ~~ cqs)
  121.85        end
  121.86 @@ -714,13 +720,14 @@
  121.87  val wf_in_rel = @{thm FunDef.wf_in_rel}
  121.88  val in_rel_def = @{thm FunDef.in_rel_def}
  121.89  
  121.90 -fun mk_nest_term_case thy globals R' ihyp clause =
  121.91 +fun mk_nest_term_case ctxt globals R' ihyp clause =
  121.92    let
  121.93 +    val thy = Proof_Context.theory_of ctxt
  121.94      val Globals {z, ...} = globals
  121.95      val ClauseInfo {cdata = ClauseContext {qs, cqs, ags, lhs, case_hyp, ...}, tree,
  121.96        qglr=(oqs, _, _, _), ...} = clause
  121.97  
  121.98 -    val ih_case = full_simplify (HOL_basic_ss addsimps [case_hyp]) ihyp
  121.99 +    val ih_case = full_simplify (put_simpset HOL_basic_ss ctxt addsimps [case_hyp]) ihyp
 121.100  
 121.101      fun step (fixes, assumes) (_ $ arg) u (sub,(hyps,thms)) =
 121.102        let
 121.103 @@ -763,8 +770,9 @@
 121.104    end
 121.105  
 121.106  
 121.107 -fun mk_nest_term_rule thy globals R R_cases clauses =
 121.108 +fun mk_nest_term_rule ctxt globals R R_cases clauses =
 121.109    let
 121.110 +    val thy = Proof_Context.theory_of ctxt
 121.111      val Globals { domT, x, z, ... } = globals
 121.112      val acc_R = mk_acc domT R
 121.113  
 121.114 @@ -788,7 +796,7 @@
 121.115  
 121.116      val R_z_x = cterm_of thy (HOLogic.mk_Trueprop (R $ z $ x))
 121.117  
 121.118 -    val (hyps, cases) = fold (mk_nest_term_case thy globals R' ihyp_a) clauses ([], [])
 121.119 +    val (hyps, cases) = fold (mk_nest_term_case ctxt globals R' ihyp_a) clauses ([], [])
 121.120    in
 121.121      R_cases
 121.122      |> Thm.forall_elim (cterm_of thy z)
 121.123 @@ -810,7 +818,7 @@
 121.124      |> Thm.forall_intr (cterm_of thy R')
 121.125      |> Thm.forall_elim (cterm_of thy (inrel_R))
 121.126      |> curry op RS wf_in_rel
 121.127 -    |> full_simplify (HOL_basic_ss addsimps [in_rel_def])
 121.128 +    |> full_simplify (put_simpset HOL_basic_ss ctxt addsimps [in_rel_def])
 121.129      |> Thm.forall_intr (cterm_of thy Rrel)
 121.130    end
 121.131  
 121.132 @@ -882,6 +890,7 @@
 121.133      fun mk_partial_rules provedgoal =
 121.134        let
 121.135          val newthy = theory_of_thm provedgoal (*FIXME*)
 121.136 +        val newctxt = Proof_Context.init_global newthy (*FIXME*)
 121.137  
 121.138          val (graph_is_function, complete_thm) =
 121.139            provedgoal
 121.140 @@ -891,13 +900,13 @@
 121.141          val f_iff = graph_is_function RS (f_defthm RS ex1_implies_iff)
 121.142  
 121.143          val psimps = PROFILE "Proving simplification rules"
 121.144 -          (mk_psimps newthy globals R xclauses values f_iff) graph_is_function
 121.145 +          (mk_psimps newctxt globals R xclauses values f_iff) graph_is_function
 121.146  
 121.147          val simple_pinduct = PROFILE "Proving partial induction rule"
 121.148            (mk_partial_induct_rule newthy globals R complete_thm) xclauses
 121.149  
 121.150          val total_intro = PROFILE "Proving nested termination rule"
 121.151 -          (mk_nest_term_rule newthy globals R R_elim) xclauses
 121.152 +          (mk_nest_term_rule newctxt globals R R_elim) xclauses
 121.153  
 121.154          val dom_intros =
 121.155            if domintros then SOME (PROFILE "Proving domain introduction rules"
   122.1 --- a/src/HOL/Tools/Function/induction_schema.ML	Tue Apr 16 17:54:14 2013 +0200
   122.2 +++ b/src/HOL/Tools/Function/induction_schema.ML	Thu Apr 18 17:07:01 2013 +0200
   122.3 @@ -231,7 +231,7 @@
   122.4      val xss = map (fn (SchemeBranch { xs, ... }) => map Free xs) branches
   122.5      val pats = map_index (uncurry inject) xss
   122.6      val sum_split_rule =
   122.7 -      Pat_Completeness.prove_completeness thy [x] (P_comp $ x) xss (map single pats)
   122.8 +      Pat_Completeness.prove_completeness ctxt [x] (P_comp $ x) xss (map single pats)
   122.9  
  122.10      fun prove_branch (bidx, (SchemeBranch { P, xs, ws, Cs, ... }, (complete_thm, pat))) =
  122.11        let
  122.12 @@ -253,8 +253,9 @@
  122.13              val cqs = map (cert o Free) qs
  122.14              val ags = map (Thm.assume o cert) gs
  122.15  
  122.16 -            val replace_x_ss = HOL_basic_ss addsimps (branch_hyp :: case_hyps)
  122.17 -            val sih = full_simplify replace_x_ss aihyp
  122.18 +            val replace_x_simpset =
  122.19 +              put_simpset HOL_basic_ss ctxt addsimps (branch_hyp :: case_hyps)
  122.20 +            val sih = full_simplify replace_x_simpset aihyp
  122.21  
  122.22              fun mk_Prec (idx, Gvs, Gas, rcargs) (ineq, pres) =
  122.23                let
  122.24 @@ -373,7 +374,7 @@
  122.25        in
  122.26          indthm
  122.27          |> Drule.instantiate' [] [SOME inst]
  122.28 -        |> simplify SumTree.sumcase_split_ss
  122.29 +        |> simplify (put_simpset SumTree.sumcase_split_ss ctxt'')
  122.30          |> Conv.fconv_rule ind_rulify
  122.31        end
  122.32  
   123.1 --- a/src/HOL/Tools/Function/lexicographic_order.ML	Tue Apr 16 17:54:14 2013 +0200
   123.2 +++ b/src/HOL/Tools/Function/lexicographic_order.ML	Thu Apr 18 17:07:01 2013 +0200
   123.3 @@ -212,7 +212,7 @@
   123.4  fun lexicographic_order_tac quiet ctxt =
   123.5    TRY (Function_Common.apply_termination_rule ctxt 1) THEN
   123.6    lex_order_tac quiet ctxt
   123.7 -    (auto_tac (map_simpset (fn ss => ss addsimps Function_Common.Termination_Simps.get ctxt) ctxt))
   123.8 +    (auto_tac (ctxt addsimps Function_Common.Termination_Simps.get ctxt))
   123.9  
  123.10  val setup =
  123.11    Context.theory_map (Function_Common.set_termination_prover (lexicographic_order_tac false))
   124.1 --- a/src/HOL/Tools/Function/mutual.ML	Tue Apr 16 17:54:14 2013 +0200
   124.2 +++ b/src/HOL/Tools/Function/mutual.ML	Thu Apr 18 17:07:01 2013 +0200
   124.3 @@ -193,7 +193,7 @@
   124.4        (fn _ =>
   124.5          Local_Defs.unfold_tac ctxt all_orig_fdefs
   124.6            THEN EqSubst.eqsubst_tac ctxt [0] [simp] 1
   124.7 -          THEN (simp_tac (simpset_of ctxt)) 1)
   124.8 +          THEN (simp_tac ctxt) 1)
   124.9      |> restore_cond
  124.10      |> export
  124.11    end
  124.12 @@ -209,9 +209,9 @@
  124.13      |> Thm.forall_elim_vars 0
  124.14    end
  124.15  
  124.16 -fun mutual_induct_rules lthy induct all_f_defs (Mutual {n, ST, parts, ...}) =
  124.17 +fun mutual_induct_rules ctxt induct all_f_defs (Mutual {n, ST, parts, ...}) =
  124.18    let
  124.19 -    val cert = cterm_of (Proof_Context.theory_of lthy)
  124.20 +    val cert = cterm_of (Proof_Context.theory_of ctxt)
  124.21      val newPs =
  124.22        map2 (fn Pname => fn MutualPart {cargTs, ...} =>
  124.23            Free (Pname, cargTs ---> HOLogic.boolT))
  124.24 @@ -230,8 +230,8 @@
  124.25  
  124.26      val induct_inst =
  124.27        Thm.forall_elim (cert case_exp) induct
  124.28 -      |> full_simplify SumTree.sumcase_split_ss
  124.29 -      |> full_simplify (HOL_basic_ss addsimps all_f_defs)
  124.30 +      |> full_simplify (put_simpset SumTree.sumcase_split_ss ctxt)
  124.31 +      |> full_simplify (put_simpset HOL_basic_ss ctxt addsimps all_f_defs)
  124.32  
  124.33      fun project rule (MutualPart {cargTs, i, ...}) k =
  124.34        let
  124.35 @@ -240,7 +240,7 @@
  124.36        in
  124.37          (rule
  124.38           |> Thm.forall_elim (cert inj)
  124.39 -         |> full_simplify SumTree.sumcase_split_ss
  124.40 +         |> full_simplify (put_simpset SumTree.sumcase_split_ss ctxt)
  124.41           |> fold_rev (Thm.forall_intr o cert) (afs @ newPs),
  124.42           k + length cargTs)
  124.43        end
  124.44 @@ -266,11 +266,11 @@
  124.45      fun mk_mpsimp fqgar sum_psimp =
  124.46        in_context lthy fqgar (recover_mutual_psimp all_orig_fdefs parts) sum_psimp
  124.47  
  124.48 -    val rew_ss = HOL_basic_ss addsimps all_f_defs
  124.49 +    val rew_simpset = put_simpset HOL_basic_ss lthy addsimps all_f_defs
  124.50      val mpsimps = map2 mk_mpsimp fqgars psimps
  124.51      val minducts = mutual_induct_rules lthy simple_pinduct all_f_defs m
  124.52 -    val mtermination = full_simplify rew_ss termination
  124.53 -    val mdomintros = Option.map (map (full_simplify rew_ss)) domintros
  124.54 +    val mtermination = full_simplify rew_simpset termination
  124.55 +    val mdomintros = Option.map (map (full_simplify rew_simpset)) domintros
  124.56    in
  124.57      FunctionResult { fs=fs, G=G, R=R,
  124.58        psimps=mpsimps, simple_pinducts=minducts,
   125.1 --- a/src/HOL/Tools/Function/partial_function.ML	Tue Apr 16 17:54:14 2013 +0200
   125.2 +++ b/src/HOL/Tools/Function/partial_function.ML	Thu Apr 18 17:07:01 2013 +0200
   125.3 @@ -157,11 +157,13 @@
   125.4  fun curry_n arity = funpow (arity - 1) mk_curry;
   125.5  fun uncurry_n arity = funpow (arity - 1) HOLogic.mk_split;
   125.6  
   125.7 -val curry_uncurry_ss = HOL_basic_ss addsimps
   125.8 -  [@{thm Product_Type.curry_split}, @{thm Product_Type.split_curry}]
   125.9 +val curry_uncurry_ss =
  125.10 +  simpset_of (put_simpset HOL_basic_ss @{context}
  125.11 +    addsimps [@{thm Product_Type.curry_split}, @{thm Product_Type.split_curry}])
  125.12  
  125.13 -val split_conv_ss = HOL_basic_ss addsimps
  125.14 -  [@{thm Product_Type.split_conv}];
  125.15 +val split_conv_ss =
  125.16 +  simpset_of (put_simpset HOL_basic_ss @{context}
  125.17 +    addsimps [@{thm Product_Type.split_conv}]);
  125.18  
  125.19  fun mk_curried_induct args ctxt ccurry cuncurry rule =
  125.20    let
  125.21 @@ -187,12 +189,12 @@
  125.22  
  125.23      val inst_rule' = inst_rule
  125.24        |> Tactic.rule_by_tactic ctxt
  125.25 -        (Simplifier.simp_tac curry_uncurry_ss 4
  125.26 -         THEN Simplifier.simp_tac curry_uncurry_ss 3
  125.27 +        (Simplifier.simp_tac (put_simpset curry_uncurry_ss ctxt) 4
  125.28 +         THEN Simplifier.simp_tac (put_simpset curry_uncurry_ss ctxt) 3
  125.29           THEN CONVERSION (split_params_conv ctxt
  125.30             then_conv (Conv.forall_conv (K split_paired_all_conv) ctxt)) 3)
  125.31        |> Drule.instantiate' [] [NONE, NONE, SOME P_inst, SOME x_inst]
  125.32 -      |> Simplifier.full_simplify split_conv_ss
  125.33 +      |> Simplifier.full_simplify (put_simpset split_conv_ss ctxt)
  125.34        |> singleton (Variable.export ctxt' ctxt)
  125.35    in
  125.36      inst_rule'
  125.37 @@ -253,7 +255,7 @@
  125.38      val unfold =
  125.39        (cterm_instantiate' (map (SOME o cert) [uncurry, F, curry]) fixp_eq
  125.40          OF [mono_thm, f_def])
  125.41 -      |> Tactic.rule_by_tactic lthy (Simplifier.simp_tac curry_uncurry_ss 1);
  125.42 +      |> Tactic.rule_by_tactic lthy (Simplifier.simp_tac (put_simpset curry_uncurry_ss lthy) 1);
  125.43  
  125.44      val mk_raw_induct =
  125.45        mk_curried_induct args args_ctxt (cert curry) (cert uncurry)
   126.1 --- a/src/HOL/Tools/Function/pat_completeness.ML	Tue Apr 16 17:54:14 2013 +0200
   126.2 +++ b/src/HOL/Tools/Function/pat_completeness.ML	Thu Apr 18 17:07:01 2013 +0200
   126.3 @@ -7,7 +7,7 @@
   126.4  signature PAT_COMPLETENESS =
   126.5  sig
   126.6      val pat_completeness_tac: Proof.context -> int -> tactic
   126.7 -    val prove_completeness : theory -> term list -> term -> term list list ->
   126.8 +    val prove_completeness : Proof.context -> term list -> term -> term list list ->
   126.9        term list list -> thm
  126.10  end
  126.11  
  126.12 @@ -61,12 +61,13 @@
  126.13    | inst_constrs_of thy _ = raise Match
  126.14  
  126.15  
  126.16 -fun transform_pat thy avars c_assum ([] , thm) = raise Match
  126.17 -  | transform_pat thy avars c_assum (pat :: pats, thm) =
  126.18 +fun transform_pat _ avars c_assum ([] , thm) = raise Match
  126.19 +  | transform_pat ctxt avars c_assum (pat :: pats, thm) =
  126.20    let
  126.21 +    val thy = Proof_Context.theory_of ctxt
  126.22      val (_, subps) = strip_comb pat
  126.23      val eqs = map (cterm_of thy o HOLogic.mk_Trueprop o HOLogic.mk_eq) (avars ~~ subps)
  126.24 -    val c_eq_pat = simplify (HOL_basic_ss addsimps (map Thm.assume eqs)) c_assum
  126.25 +    val c_eq_pat = simplify (put_simpset HOL_basic_ss ctxt addsimps (map Thm.assume eqs)) c_assum
  126.26    in
  126.27      (subps @ pats,
  126.28       fold_rev Thm.implies_intr eqs (Thm.implies_elim thm c_eq_pat))
  126.29 @@ -75,40 +76,45 @@
  126.30  
  126.31  exception COMPLETENESS
  126.32  
  126.33 -fun constr_case thy P idx (v :: vs) pats cons =
  126.34 +fun constr_case ctxt P idx (v :: vs) pats cons =
  126.35    let
  126.36 +    val thy = Proof_Context.theory_of ctxt
  126.37      val (avars, pvars, newidx) = invent_vars cons idx
  126.38      val c_hyp = cterm_of thy (HOLogic.mk_Trueprop (HOLogic.mk_eq (v, list_comb (cons, avars))))
  126.39      val c_assum = Thm.assume c_hyp
  126.40 -    val newpats = map (transform_pat thy avars c_assum) (filter_pats thy cons pvars pats)
  126.41 +    val newpats = map (transform_pat ctxt avars c_assum) (filter_pats thy cons pvars pats)
  126.42    in
  126.43 -    o_alg thy P newidx (avars @ vs) newpats
  126.44 +    o_alg ctxt P newidx (avars @ vs) newpats
  126.45      |> Thm.implies_intr c_hyp
  126.46      |> fold_rev (Thm.forall_intr o cterm_of thy) avars
  126.47    end
  126.48    | constr_case _ _ _ _ _ _ = raise Match
  126.49 -and o_alg thy P idx [] (([], Pthm) :: _)  = Pthm
  126.50 -  | o_alg thy P idx (v :: vs) [] = raise COMPLETENESS
  126.51 -  | o_alg thy P idx (v :: vs) pts =
  126.52 +and o_alg _ P idx [] (([], Pthm) :: _)  = Pthm
  126.53 +  | o_alg _ P idx (v :: vs) [] = raise COMPLETENESS
  126.54 +  | o_alg ctxt P idx (v :: vs) pts =
  126.55    if forall (is_Free o hd o fst) pts (* Var case *)
  126.56 -  then o_alg thy P idx vs
  126.57 +  then o_alg ctxt P idx vs
  126.58           (map (fn (pv :: pats, thm) =>
  126.59 -           (pats, refl RS (inst_free (cterm_of thy pv) (cterm_of thy v) thm))) pts)
  126.60 +           (pats, refl RS
  126.61 +            (inst_free (cterm_of (Proof_Context.theory_of ctxt) pv)
  126.62 +              (cterm_of (Proof_Context.theory_of ctxt) v) thm))) pts)
  126.63    else (* Cons case *)
  126.64      let
  126.65 +      val thy = Proof_Context.theory_of ctxt
  126.66        val T = fastype_of v
  126.67        val (tname, _) = dest_Type T
  126.68        val {exhaust=case_thm, ...} = Datatype.the_info thy tname
  126.69        val constrs = inst_constrs_of thy T
  126.70 -      val c_cases = map (constr_case thy P idx (v :: vs) pts) constrs
  126.71 +      val c_cases = map (constr_case ctxt P idx (v :: vs) pts) constrs
  126.72      in
  126.73        inst_case_thm thy v P case_thm
  126.74        |> fold (curry op COMP) c_cases
  126.75      end
  126.76    | o_alg _ _ _ _ _ = raise Match
  126.77  
  126.78 -fun prove_completeness thy xs P qss patss =
  126.79 +fun prove_completeness ctxt xs P qss patss =
  126.80    let
  126.81 +    val thy = Proof_Context.theory_of ctxt
  126.82      fun mk_assum qs pats =
  126.83        HOLogic.mk_Trueprop P
  126.84        |> fold_rev (curry Logic.mk_implies o HOLogic.mk_Trueprop o HOLogic.mk_eq) (xs ~~ pats)
  126.85 @@ -119,7 +125,7 @@
  126.86      fun inst_hyps hyp qs = fold (Thm.forall_elim o cterm_of thy) qs (Thm.assume hyp)
  126.87      val assums = map2 inst_hyps hyps qss
  126.88      in
  126.89 -      o_alg thy P 2 xs (patss ~~ assums)
  126.90 +      o_alg ctxt P 2 xs (patss ~~ assums)
  126.91        |> fold_rev Thm.implies_intr hyps
  126.92      end
  126.93  
  126.94 @@ -143,7 +149,7 @@
  126.95        handle List.Empty => raise COMPLETENESS
  126.96  
  126.97      val patss = map (map snd) x_pats
  126.98 -    val complete_thm = prove_completeness thy xs thesis qss patss
  126.99 +    val complete_thm = prove_completeness ctxt xs thesis qss patss
 126.100        |> fold_rev (Thm.forall_intr o cterm_of thy) vs
 126.101      in
 126.102        PRIMITIVE (fn st => Drule.compose_single(complete_thm, i, st))
   127.1 --- a/src/HOL/Tools/Function/scnp_reconstruct.ML	Tue Apr 16 17:54:14 2013 +0200
   127.2 +++ b/src/HOL/Tools/Function/scnp_reconstruct.ML	Thu Apr 18 17:07:01 2013 +0200
   127.3 @@ -289,7 +289,7 @@
   127.4           THEN (rtac @{thm rp_inv_image_rp} 1)
   127.5           THEN (rtac (order_rpair ms_rp label) 1)
   127.6           THEN PRIMITIVE (instantiate' [] [SOME level_mapping])
   127.7 -         THEN unfold_tac @{thms rp_inv_image_def} (simpset_of ctxt)
   127.8 +         THEN unfold_tac @{thms rp_inv_image_def} ctxt
   127.9           THEN Local_Defs.unfold_tac ctxt
  127.10             (@{thms split_conv} @ @{thms fst_conv} @ @{thms snd_conv})
  127.11           THEN REPEAT (SOMEGOAL (resolve_tac [@{thm Un_least}, @{thm empty_subsetI}]))
  127.12 @@ -338,7 +338,7 @@
  127.13  fun decomp_scnp_tac orders ctxt =
  127.14    let
  127.15      val extra_simps = Function_Common.Termination_Simps.get ctxt
  127.16 -    val autom_tac = auto_tac (map_simpset (fn ss => ss addsimps extra_simps) ctxt)
  127.17 +    val autom_tac = auto_tac (ctxt addsimps extra_simps)
  127.18    in
  127.19       gen_sizechange_tac orders autom_tac ctxt
  127.20    end
   128.1 --- a/src/HOL/Tools/Function/size.ML	Tue Apr 16 17:54:14 2013 +0200
   128.2 +++ b/src/HOL/Tools/Function/size.ML	Thu Apr 18 17:07:01 2013 +0200
   128.3 @@ -149,8 +149,9 @@
   128.4  
   128.5      val ctxt = Proof_Context.init_global thy';
   128.6  
   128.7 -    val simpset1 = HOL_basic_ss addsimps @{thm Nat.add_0} :: @{thm Nat.add_0_right} ::
   128.8 -      size_def_thms @ size_def_thms' @ rec_rewrites @ extra_rewrites;
   128.9 +    val simpset1 =
  128.10 +      put_simpset HOL_basic_ss ctxt addsimps @{thm Nat.add_0} :: @{thm Nat.add_0_right} ::
  128.11 +        size_def_thms @ size_def_thms' @ rec_rewrites @ extra_rewrites;
  128.12      val xs = map (fn i => "x" ^ string_of_int i) (1 upto length recTs2);
  128.13  
  128.14      fun mk_unfolded_size_eq tab size_ofp fs (p as (x, T), r) =
  128.15 @@ -186,10 +187,12 @@
  128.16             else foldl1 plus (ts @ [HOLogic.Suc_zero])))
  128.17        end;
  128.18  
  128.19 -    val simpset2 = HOL_basic_ss addsimps
  128.20 -      rec_rewrites @ size_def_thms @ unfolded_size_eqs1;
  128.21 -    val simpset3 = HOL_basic_ss addsimps
  128.22 -      rec_rewrites @ size_def_thms' @ unfolded_size_eqs2;
  128.23 +    val simpset2 =
  128.24 +      put_simpset HOL_basic_ss ctxt
  128.25 +        addsimps (rec_rewrites @ size_def_thms @ unfolded_size_eqs1);
  128.26 +    val simpset3 =
  128.27 +      put_simpset HOL_basic_ss ctxt
  128.28 +        addsimps (rec_rewrites @ size_def_thms' @ unfolded_size_eqs2);
  128.29  
  128.30      fun prove_size_eqs p size_fns size_ofp simpset =
  128.31        maps (fn (((_, (_, _, constrs)), size_const), T) =>
   129.1 --- a/src/HOL/Tools/Function/sum_tree.ML	Tue Apr 16 17:54:14 2013 +0200
   129.2 +++ b/src/HOL/Tools/Function/sum_tree.ML	Thu Apr 18 17:07:01 2013 +0200
   129.3 @@ -21,7 +21,8 @@
   129.4  
   129.5  (* Theory dependencies *)
   129.6  val sumcase_split_ss =
   129.7 -  HOL_basic_ss addsimps (@{thm Product_Type.split} :: @{thms sum.cases})
   129.8 +  simpset_of (put_simpset HOL_basic_ss @{context}
   129.9 +    addsimps (@{thm Product_Type.split} :: @{thms sum.cases}))
  129.10  
  129.11  (* top-down access in balanced tree *)
  129.12  fun access_top_down {left, right, init} len i =
   130.1 --- a/src/HOL/Tools/Meson/meson.ML	Tue Apr 16 17:54:14 2013 +0200
   130.2 +++ b/src/HOL/Tools/Meson/meson.ML	Thu Apr 18 17:07:01 2013 +0200
   130.3 @@ -19,7 +19,7 @@
   130.4      -> Proof.context -> thm list * Proof.context
   130.5    val finish_cnf: thm list -> thm list
   130.6    val presimplified_consts : string list
   130.7 -  val presimplify: thm -> thm
   130.8 +  val presimplify: Proof.context -> thm -> thm
   130.9    val make_nnf: Proof.context -> thm -> thm
  130.10    val choice_theorems : theory -> thm list
  130.11    val skolemize_with_choice_theorems : Proof.context -> thm list -> thm -> thm
  130.12 @@ -541,22 +541,23 @@
  130.13  (* FIXME: "let_simp" is probably redundant now that we also rewrite with
  130.14    "Let_def [abs_def]". *)
  130.15  val nnf_ss =
  130.16 -  HOL_basic_ss addsimps nnf_extra_simps
  130.17 +  simpset_of (put_simpset HOL_basic_ss @{context}
  130.18 +    addsimps nnf_extra_simps
  130.19      addsimprocs [@{simproc defined_All}, @{simproc defined_Ex}, @{simproc neq},
  130.20 -                 @{simproc let_simp}]
  130.21 +                 @{simproc let_simp}])
  130.22  
  130.23  val presimplified_consts =
  130.24    [@{const_name simp_implies}, @{const_name False}, @{const_name True},
  130.25     @{const_name Ex1}, @{const_name Ball}, @{const_name Bex}, @{const_name If},
  130.26     @{const_name Let}]
  130.27  
  130.28 -val presimplify =
  130.29 +fun presimplify ctxt =
  130.30    rewrite_rule (map safe_mk_meta_eq nnf_simps)
  130.31 -  #> simplify nnf_ss
  130.32 +  #> simplify (put_simpset nnf_ss ctxt)
  130.33    #> Raw_Simplifier.rewrite_rule @{thms Let_def [abs_def]}
  130.34  
  130.35  fun make_nnf ctxt th = case prems_of th of
  130.36 -    [] => th |> presimplify |> make_nnf1 ctxt
  130.37 +    [] => th |> presimplify ctxt |> make_nnf1 ctxt
  130.38    | _ => raise THM ("make_nnf: premises in argument", 0, [th]);
  130.39  
  130.40  fun choice_theorems thy =
   131.1 --- a/src/HOL/Tools/Meson/meson_clausify.ML	Tue Apr 16 17:54:14 2013 +0200
   131.2 +++ b/src/HOL/Tools/Meson/meson_clausify.ML	Thu Apr 18 17:07:01 2013 +0200
   131.3 @@ -14,7 +14,7 @@
   131.4    val introduce_combinators_in_cterm : cterm -> thm
   131.5    val introduce_combinators_in_theorem : thm -> thm
   131.6    val cluster_of_zapped_var_name : string -> (int * (int * int)) * bool
   131.7 -  val ss_only : thm list -> simpset
   131.8 +  val ss_only : thm list -> Proof.context -> Proof.context
   131.9    val cnf_axiom :
  131.10      Proof.context -> bool -> bool -> int -> thm
  131.11      -> (thm * term) option * thm list
  131.12 @@ -292,7 +292,7 @@
  131.13          else Conv.all_conv
  131.14        | _ => Conv.all_conv)
  131.15  
  131.16 -fun ss_only ths = Simplifier.clear_ss HOL_basic_ss addsimps ths
  131.17 +fun ss_only ths ctxt = clear_simpset (put_simpset HOL_basic_ss ctxt) addsimps ths
  131.18  
  131.19  val cheat_choice =
  131.20    @{prop "ALL x. EX y. Q x y ==> EX f. ALL x. Q x (f x)"}
  131.21 @@ -317,11 +317,11 @@
  131.22        let
  131.23          fun skolemize choice_ths =
  131.24            skolemize_with_choice_theorems ctxt choice_ths
  131.25 -          #> simplify (ss_only @{thms all_simps[symmetric]})
  131.26 +          #> simplify (ss_only @{thms all_simps[symmetric]} ctxt)
  131.27          val no_choice = null choice_ths
  131.28          val pull_out =
  131.29            if no_choice then
  131.30 -            simplify (ss_only @{thms all_simps[symmetric] ex_simps[symmetric]})
  131.31 +            simplify (ss_only @{thms all_simps[symmetric] ex_simps[symmetric]} ctxt)
  131.32            else
  131.33              skolemize choice_ths
  131.34          val discharger_th = th |> pull_out
   132.1 --- a/src/HOL/Tools/Metis/metis_tactic.ML	Tue Apr 16 17:54:14 2013 +0200
   132.2 +++ b/src/HOL/Tools/Metis/metis_tactic.ML	Thu Apr 18 17:07:01 2013 +0200
   132.3 @@ -249,7 +249,7 @@
   132.4  fun preskolem_tac ctxt st0 =
   132.5    (if exists (Meson.has_too_many_clauses ctxt)
   132.6               (Logic.prems_of_goal (prop_of st0) 1) then
   132.7 -     Simplifier.full_simp_tac (Meson_Clausify.ss_only @{thms not_all not_ex}) 1
   132.8 +     Simplifier.full_simp_tac (Meson_Clausify.ss_only @{thms not_all not_ex} ctxt) 1
   132.9       THEN cnf.cnfx_rewrite_tac ctxt 1
  132.1