change_claset/simpset;
authorwenzelm
Mon, 17 Oct 2005 23:10:10 +0200
changeset 17875 d81094515061
parent 17874 8be65cf94d2e
child 17876 b9c92f384109
change_claset/simpset; Simplifier.inherit_context instead of Simplifier.inherit_bounds;
src/FOL/simpdata.ML
src/HOL/Integ/int_arith1.ML
src/HOL/Product_Type.thy
src/HOL/Set.thy
src/HOL/Tools/datatype_package.ML
src/HOL/Tools/record_package.ML
src/HOL/arith_data.ML
src/HOL/simpdata.ML
--- a/src/FOL/simpdata.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/FOL/simpdata.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -339,7 +339,7 @@
 
 fun unfold_tac ss ths =
   ALLGOALS (full_simp_tac
-    (Simplifier.inherit_bounds ss (Simplifier.clear_ss FOL_basic_ss) addsimps ths));
+    (Simplifier.inherit_context ss (Simplifier.clear_ss FOL_basic_ss) addsimps ths));
 
 
 (*intuitionistic simprules only*)
@@ -360,7 +360,7 @@
 (*classical simprules too*)
 val FOL_ss = IFOL_ss addsimps (cla_simps @ cla_ex_simps @ cla_all_simps);
 
-val simpsetup = [fn thy => (simpset_ref_of thy := FOL_ss; thy)];
+val simpsetup = [fn thy => (change_simpset_of thy (fn _ => FOL_ss); thy)];
 
 
 (*** integration of simplifier with classical reasoner ***)
--- a/src/HOL/Integ/int_arith1.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/Integ/int_arith1.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -309,7 +309,7 @@
   | trans_tac (SOME th) = ALLGOALS (rtac (th RS trans));
 
 fun simplify_meta_eq rules ss =
-    simplify (Simplifier.inherit_bounds ss HOL_basic_ss addeqcongs[eq_cong2] addsimps rules)
+    simplify (Simplifier.inherit_context ss HOL_basic_ss addeqcongs[eq_cong2] addsimps rules)
     o mk_meta_eq;
 
 structure CancelNumeralsCommon =
@@ -321,14 +321,14 @@
   val find_first_coeff  = find_first_coeff []
   val trans_tac         = fn _ => trans_tac
   fun norm_tac ss =
-    let val num_ss' = Simplifier.inherit_bounds ss num_ss in
+    let val num_ss' = Simplifier.inherit_context ss num_ss in
       ALLGOALS (simp_tac (num_ss' addsimps numeral_syms @ add_0s @ mult_1s @
                                          diff_simps @ minus_simps @ add_ac))
       THEN ALLGOALS (simp_tac (num_ss' addsimps non_add_bin_simps @ mult_minus_simps))
       THEN ALLGOALS (simp_tac (num_ss' addsimps minus_from_mult_simps @ add_ac @ mult_ac))
     end
   fun numeral_simp_tac ss =
-    ALLGOALS (simp_tac (Simplifier.inherit_bounds ss HOL_ss addsimps add_0s @ bin_simps))
+    ALLGOALS (simp_tac (Simplifier.inherit_context ss HOL_ss addsimps add_0s @ bin_simps))
   val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
   end;
 
@@ -399,14 +399,14 @@
   val prove_conv        = Bin_Simprocs.prove_conv_nohyps
   val trans_tac         = fn _ => trans_tac
   fun norm_tac ss =
-    let val num_ss' = Simplifier.inherit_bounds ss num_ss in
+    let val num_ss' = Simplifier.inherit_context ss num_ss in
       ALLGOALS (simp_tac (num_ss' addsimps numeral_syms @ add_0s @ mult_1s @
                                           diff_simps @ minus_simps @ add_ac))
       THEN ALLGOALS (simp_tac (num_ss' addsimps non_add_bin_simps @ mult_minus_simps))
       THEN ALLGOALS (simp_tac (num_ss' addsimps minus_from_mult_simps @ add_ac @ mult_ac))
     end
   fun numeral_simp_tac ss =
-    ALLGOALS (simp_tac (Simplifier.inherit_bounds ss HOL_ss addsimps add_0s @ bin_simps))
+    ALLGOALS (simp_tac (Simplifier.inherit_context ss HOL_ss addsimps add_0s @ bin_simps))
   val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
   end;
 
--- a/src/HOL/Product_Type.thy	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/Product_Type.thy	Mon Oct 17 23:10:10 2005 +0200
@@ -320,7 +320,7 @@
    if exists_paired_all (#prop (Thm.rep_thm th)) then full_simplify ss th else th;
   end;
 
-claset_ref() := claset() addSbefore ("split_all_tac", split_all_tac);
+change_claset (fn cs => cs addSbefore ("split_all_tac", split_all_tac));
 *}
 
 lemma split_paired_All [simp]: "(ALL x. P x) = (ALL a b. P (a, b))"
@@ -415,7 +415,7 @@
   |   split_pat tp i _ = NONE;
   fun metaeq thy ss lhs rhs = mk_meta_eq (Tactic.prove thy [] []
         (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs)))
-        (K (simp_tac (Simplifier.inherit_bounds ss HOL_basic_ss addsimps [cond_split_eta]) 1)));
+        (K (simp_tac (Simplifier.inherit_context ss HOL_basic_ss addsimps [cond_split_eta]) 1)));
 
   fun beta_term_pat k i (Abs (_, _, t)) = beta_term_pat (k+1) i t
   |   beta_term_pat k i (t $ u) = Pair_pat k i (t $ u) orelse
@@ -529,7 +529,7 @@
 end;
 (* This prevents applications of splitE for already splitted arguments leading
    to quite time-consuming computations (in particular for nested tuples) *)
-claset_ref() := claset() addSbefore ("split_conv_tac", split_conv_tac);
+change_claset (fn cs => cs addSbefore ("split_conv_tac", split_conv_tac));
 *}
 
 lemma split_eta_SetCompr [simp]: "(%u. EX x y. u = (x, y) & P (x, y)) = P"
--- a/src/HOL/Set.thy	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/Set.thy	Mon Oct 17 23:10:10 2005 +0200
@@ -380,7 +380,7 @@
 *}
 
 ML_setup {*
-  claset_ref() := claset() addbefore ("bspec", datac (thm "bspec") 1);
+  change_claset (fn cs => cs addbefore ("bspec", datac (thm "bspec") 1));
 *}
 
 lemma bexI [intro]: "P x ==> x:A ==> EX x:A. P x"
@@ -431,7 +431,7 @@
 
     val simpset = Simplifier.clear_ss HOL_basic_ss;
     fun unfold_tac ss th =
-      ALLGOALS (full_simp_tac (Simplifier.inherit_bounds ss simpset addsimps [th]));
+      ALLGOALS (full_simp_tac (Simplifier.inherit_context ss simpset addsimps [th]));
 
     fun prove_bex_tac ss =
       unfold_tac ss Bex_def THEN Quantifier1.prove_one_point_ex_tac;
@@ -977,7 +977,7 @@
 
 ML_setup {*
   val mksimps_pairs = [("Ball", [thm "bspec"])] @ mksimps_pairs;
-  simpset_ref() := simpset() setmksimps (mksimps mksimps_pairs);
+  change_simpset (fn ss => ss setmksimps (mksimps mksimps_pairs));
 *}
 
 declare subset_UNIV [simp] subset_refl [simp]
--- a/src/HOL/Tools/datatype_package.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/Tools/datatype_package.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -352,7 +352,7 @@
                                     atac 2, resolve_tac thms 1, etac FalseE 1])))
                                | ManyConstrs (thm, simpset) => SOME (Tactic.prove sg [] [] eq_t (K
                                    (EVERY [rtac eq_reflection 1, rtac iffI 1, dtac thm 1,
-                                    full_simp_tac (Simplifier.inherit_bounds ss simpset) 1,
+                                    full_simp_tac (Simplifier.inherit_context ss simpset) 1,
                                     REPEAT (dresolve_tac [In0_inject, In1_inject] 1),
                                     eresolve_tac [In0_not_In1 RS notE, In1_not_In0 RS notE] 1,
                                     etac FalseE 1]))))
@@ -372,7 +372,7 @@
 
 val simproc_setup =
   [Theory.add_oracle (distinctN, fn (_, ConstrDistinct t) => t),
-   fn thy => (simpset_ref_of thy := simpset_of thy addsimprocs [distinct_simproc]; thy)];
+   fn thy => ((change_simpset_of thy) (fn ss => ss addsimprocs [distinct_simproc]); thy)];
 
 
 (**** translation rules for case ****)
--- a/src/HOL/Tools/record_package.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/Tools/record_package.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -826,7 +826,7 @@
                  | NONE => extsplits)
   in
     quick_and_dirty_prove true sg [] prop
-      (fn _ => simp_tac (Simplifier.inherit_bounds ss simpset addsimps thms) 1)
+      (fn _ => simp_tac (Simplifier.inherit_context ss simpset addsimps thms) 1)
   end;
 
 
@@ -1069,7 +1069,7 @@
        let
          fun prove prop =
            quick_and_dirty_prove true sg [] prop
-             (fn _ => simp_tac (Simplifier.inherit_bounds ss (get_simpset sg)
+             (fn _ => simp_tac (Simplifier.inherit_context ss (get_simpset sg)
                addsimps simp_thms addsimprocs [record_split_simproc (K ~1)]) 1);
 
          fun mkeq (lr,Teq,(sel,Tsel),x) i =
@@ -2106,8 +2106,8 @@
  [RecordsData.init,
   Theory.add_trfuns ([], parse_translation, [], []),
   Theory.add_advanced_trfuns ([], adv_parse_translation, [], []),
-  Simplifier.change_simpset_of Simplifier.addsimprocs
-    [record_simproc, record_upd_simproc, record_eq_simproc]];
+  (fn thy => (Simplifier.change_simpset_of thy
+    (fn ss => ss addsimprocs [record_simproc, record_upd_simproc, record_eq_simproc]); thy))];
 
 (* outer syntax *)
 
--- a/src/HOL/arith_data.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/arith_data.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -64,7 +64,7 @@
 (* rewriting *)
 
 fun simp_all_tac rules ss =
-  ALLGOALS (simp_tac (Simplifier.inherit_bounds ss HOL_ss addsimps rules));
+  ALLGOALS (simp_tac (Simplifier.inherit_context ss HOL_ss addsimps rules));
 
 val add_rules = [add_Suc, add_Suc_right, add_0, add_0_right];
 val mult_rules = [mult_Suc, mult_Suc_right, mult_0, mult_0_right];
@@ -394,7 +394,7 @@
 val add_rules =
  [add_zero_left,add_zero_right,Zero_not_Suc,Suc_not_Zero,le_0_eq,
   One_nat_def,isolateSuc,
-  order_less_irrefl, zero_neq_one, zero_less_one, zero_le_one, 
+  order_less_irrefl, zero_neq_one, zero_less_one, zero_le_one,
   zero_neq_one RS not_sym, not_one_le_zero, not_one_less_zero];
 
 val add_mono_thms_ordered_semiring = map (fn s => prove_goal (the_context ()) s
@@ -431,7 +431,7 @@
     neqE = [linorder_neqE_nat,
       get_thm (theory "Ring_and_Field") (Name "linorder_neqE_ordered_idom")],
     simpset = HOL_basic_ss addsimps add_rules
-                   addsimprocs [ab_group_add_cancel.sum_conv, 
+                   addsimprocs [ab_group_add_cancel.sum_conv,
                                 ab_group_add_cancel.rel_conv]
                    (*abel_cancel helps it work in abstract algebraic domains*)
                    addsimprocs nat_cancel_sums_add}),
@@ -538,15 +538,14 @@
 (* theory setup *)
 
 val arith_setup =
- [Simplifier.change_simpset_of (op addsimprocs) nat_cancel_sums] @
   init_lin_arith_data @
-  [Simplifier.change_simpset_of (op addSolver)
-   (mk_solver' "lin. arith." Fast_Arith.cut_lin_arith_tac),
-  Simplifier.change_simpset_of (op addsimprocs) [fast_nat_arith_simproc],
+  [fn thy => (Simplifier.change_simpset_of thy (fn ss => ss
+    addsimprocs (nat_cancel_sums @ [fast_nat_arith_simproc])
+    addSolver (mk_solver' "lin. arith." Fast_Arith.cut_lin_arith_tac)); thy),
   Method.add_methods
-      [("arith", (arith_method o #2) oo Method.syntax Args.bang_facts,
-	"decide linear arithmethic")],
+    [("arith", (arith_method o #2) oo Method.syntax Args.bang_facts,
+      "decide linear arithmethic")],
   Attrib.add_attributes [("arith_split",
-    (Attrib.no_args arith_split_add, 
+    (Attrib.no_args arith_split_add,
      Attrib.no_args Attrib.undef_local_attribute),
     "declaration of split rules for arithmetic procedure")]];
--- a/src/HOL/simpdata.ML	Mon Oct 17 19:19:29 2005 +0200
+++ b/src/HOL/simpdata.ML	Mon Oct 17 23:10:10 2005 +0200
@@ -350,7 +350,7 @@
 
 fun unfold_tac ss ths =
   ALLGOALS (full_simp_tac
-    (Simplifier.inherit_bounds ss (Simplifier.clear_ss HOL_basic_ss) addsimps ths));
+    (Simplifier.inherit_context ss (Simplifier.clear_ss HOL_basic_ss) addsimps ths));
 
 (*In general it seems wrong to add distributive laws by default: they
   might cause exponential blow-up.  But imp_disjL has been in for a while
@@ -424,7 +424,7 @@
 
 (* default simpset *)
 val simpsetup =
-  [fn thy => (simpset_ref_of thy := HOL_ss addcongs [if_weak_cong]; thy)];
+  [fn thy => (change_simpset_of thy (fn _ => HOL_ss addcongs [if_weak_cong]); thy)];
 
 
 (*** integration of simplifier with classical reasoner ***)