tuned signature;
authorwenzelm
Wed Jun 29 21:34:16 2011 +0200 (2011-06-29)
changeset 43597b4a093e755db
parent 43596 78211f66cf8d
child 43598 826ddd91ae2b
tuned signature;
src/FOL/simpdata.ML
src/HOL/HOL.thy
src/HOL/Orderings.thy
src/HOL/Tools/SMT/z3_proof_tools.ML
src/HOL/Tools/TFL/rules.ML
src/HOL/Tools/simpdata.ML
src/Provers/Arith/cancel_numeral_factor.ML
src/Provers/Arith/cancel_numerals.ML
src/Provers/Arith/extract_common_term.ML
src/Provers/Arith/fast_lin_arith.ML
src/Pure/raw_simplifier.ML
src/Pure/simplifier.ML
src/Sequents/simpdata.ML
src/ZF/Tools/inductive_package.ML
src/ZF/Tools/typechk.ML
     1.1 --- a/src/FOL/simpdata.ML	Wed Jun 29 20:39:41 2011 +0200
     1.2 +++ b/src/FOL/simpdata.ML	Wed Jun 29 21:34:16 2011 +0200
     1.3 @@ -108,11 +108,12 @@
     1.4  
     1.5  val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}];
     1.6  
     1.7 -fun unsafe_solver ss = FIRST'[resolve_tac (triv_rls @ prems_of_ss ss),
     1.8 -                                 atac, etac @{thm FalseE}];
     1.9 +fun unsafe_solver ss =
    1.10 +  FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ss), atac, etac @{thm FalseE}];
    1.11 +
    1.12  (*No premature instantiation of variables during simplification*)
    1.13 -fun safe_solver ss = FIRST'[match_tac (triv_rls @ prems_of_ss ss),
    1.14 -                                 eq_assume_tac, ematch_tac [@{thm FalseE}]];
    1.15 +fun safe_solver ss =
    1.16 +  FIRST' [match_tac (triv_rls @ Simplifier.prems_of ss), eq_assume_tac, ematch_tac @{thms FalseE}];
    1.17  
    1.18  (*No simprules, but basic infastructure for simplification*)
    1.19  val FOL_basic_ss =
     2.1 --- a/src/HOL/HOL.thy	Wed Jun 29 20:39:41 2011 +0200
     2.2 +++ b/src/HOL/HOL.thy	Wed Jun 29 21:34:16 2011 +0200
     2.3 @@ -1232,7 +1232,7 @@
     2.4    fun proc ss ct =
     2.5      (case Thm.term_of ct of
     2.6        eq $ lhs $ rhs =>
     2.7 -        (case find_first (is_neq eq lhs rhs) (Simplifier.prems_of_ss ss) of
     2.8 +        (case find_first (is_neq eq lhs rhs) (Simplifier.prems_of ss) of
     2.9            SOME thm => SOME (thm RS neq_to_EQ_False)
    2.10          | NONE => NONE)
    2.11       | _ => NONE);
     3.1 --- a/src/HOL/Orderings.thy	Wed Jun 29 20:39:41 2011 +0200
     3.2 +++ b/src/HOL/Orderings.thy	Wed Jun 29 21:34:16 2011 +0200
     3.3 @@ -534,7 +534,7 @@
     3.4  fun prp t thm = (#prop (rep_thm thm) = t);
     3.5  
     3.6  fun prove_antisym_le sg ss ((le as Const(_,T)) $ r $ s) =
     3.7 -  let val prems = prems_of_ss ss;
     3.8 +  let val prems = Simplifier.prems_of ss;
     3.9        val less = Const (@{const_name less}, T);
    3.10        val t = HOLogic.mk_Trueprop(le $ s $ r);
    3.11    in case find_first (prp t) prems of
    3.12 @@ -549,7 +549,7 @@
    3.13    handle THM _ => NONE;
    3.14  
    3.15  fun prove_antisym_less sg ss (NotC $ ((less as Const(_,T)) $ r $ s)) =
    3.16 -  let val prems = prems_of_ss ss;
    3.17 +  let val prems = Simplifier.prems_of ss;
    3.18        val le = Const (@{const_name less_eq}, T);
    3.19        val t = HOLogic.mk_Trueprop(le $ r $ s);
    3.20    in case find_first (prp t) prems of
    3.21 @@ -570,7 +570,7 @@
    3.22  
    3.23  fun add_solver name tac =
    3.24    Simplifier.map_simpset_global (fn ss => ss addSolver
    3.25 -    mk_solver name (fn ss => tac (Simplifier.the_context ss) (prems_of_ss ss)));
    3.26 +    mk_solver name (fn ss => tac (Simplifier.the_context ss) (Simplifier.prems_of ss)));
    3.27  
    3.28  in
    3.29    add_simprocs [
     4.1 --- a/src/HOL/Tools/SMT/z3_proof_tools.ML	Wed Jun 29 20:39:41 2011 +0200
     4.2 +++ b/src/HOL/Tools/SMT/z3_proof_tools.ML	Wed Jun 29 21:34:16 2011 +0200
     4.3 @@ -307,7 +307,7 @@
     4.4      let
     4.5        val (le, r, s) = dest_binop t
     4.6        val less = Const (@{const_name less}, Term.fastype_of le)
     4.7 -      val prems = Simplifier.prems_of_ss ss
     4.8 +      val prems = Simplifier.prems_of ss
     4.9      in
    4.10        (case find_first (eq_prop (le $ s $ r)) prems of
    4.11          NONE =>
    4.12 @@ -321,7 +321,7 @@
    4.13      let
    4.14        val (less, r, s) = dest_binop (HOLogic.dest_not t)
    4.15        val le = Const (@{const_name less_eq}, Term.fastype_of less)
    4.16 -      val prems = prems_of_ss ss
    4.17 +      val prems = Simplifier.prems_of ss
    4.18      in
    4.19        (case find_first (eq_prop (le $ r $ s)) prems of
    4.20          NONE =>
     5.1 --- a/src/HOL/Tools/TFL/rules.ML	Wed Jun 29 20:39:41 2011 +0200
     5.2 +++ b/src/HOL/Tools/TFL/rules.ML	Wed Jun 29 21:34:16 2011 +0200
     5.3 @@ -657,7 +657,7 @@
     5.4       fun prover used ss thm =
     5.5       let fun cong_prover ss thm =
     5.6           let val dummy = say "cong_prover:"
     5.7 -             val cntxt = Simplifier.prems_of_ss ss
     5.8 +             val cntxt = Simplifier.prems_of ss
     5.9               val dummy = print_thms "cntxt:" cntxt
    5.10               val dummy = say "cong rule:"
    5.11               val dummy = say (Display.string_of_thm_without_context thm)
    5.12 @@ -739,7 +739,7 @@
    5.13  
    5.14          fun restrict_prover ss thm =
    5.15            let val dummy = say "restrict_prover:"
    5.16 -              val cntxt = rev(Simplifier.prems_of_ss ss)
    5.17 +              val cntxt = rev (Simplifier.prems_of ss)
    5.18                val dummy = print_thms "cntxt:" cntxt
    5.19                val thy = Thm.theory_of_thm thm
    5.20                val Const("==>",_) $ (Const(@{const_name Trueprop},_) $ A) $ _ = Thm.prop_of thm
     6.1 --- a/src/HOL/Tools/simpdata.ML	Wed Jun 29 20:39:41 2011 +0200
     6.2 +++ b/src/HOL/Tools/simpdata.ML	Wed Jun 29 21:34:16 2011 +0200
     6.3 @@ -114,8 +114,8 @@
     6.4  
     6.5  fun unsafe_solver_tac ss =
     6.6    (fn i => REPEAT_DETERM (match_tac @{thms simp_impliesI} i)) THEN'
     6.7 -  FIRST' [resolve_tac (reflexive_thm :: @{thm TrueI} :: @{thm refl} :: prems_of_ss ss), atac,
     6.8 -    etac @{thm FalseE}];
     6.9 +  FIRST' [resolve_tac (reflexive_thm :: @{thm TrueI} :: @{thm refl} :: Simplifier.prems_of ss),
    6.10 +    atac, etac @{thm FalseE}];
    6.11  
    6.12  val unsafe_solver = mk_solver "HOL unsafe" unsafe_solver_tac;
    6.13  
    6.14 @@ -123,8 +123,8 @@
    6.15  (*No premature instantiation of variables during simplification*)
    6.16  fun safe_solver_tac ss =
    6.17    (fn i => REPEAT_DETERM (match_tac @{thms simp_impliesI} i)) THEN'
    6.18 -  FIRST' [match_tac (reflexive_thm :: @{thm TrueI} :: @{thm refl} :: prems_of_ss ss),
    6.19 -         eq_assume_tac, ematch_tac @{thms FalseE}];
    6.20 +  FIRST' [match_tac (reflexive_thm :: @{thm TrueI} :: @{thm refl} :: Simplifier.prems_of ss),
    6.21 +    eq_assume_tac, ematch_tac @{thms FalseE}];
    6.22  
    6.23  val safe_solver = mk_solver "HOL safe" safe_solver_tac;
    6.24  
     7.1 --- a/src/Provers/Arith/cancel_numeral_factor.ML	Wed Jun 29 20:39:41 2011 +0200
     7.2 +++ b/src/Provers/Arith/cancel_numeral_factor.ML	Wed Jun 29 21:34:16 2011 +0200
     7.3 @@ -47,7 +47,7 @@
     7.4  fun proc ss t =
     7.5    let
     7.6      val ctxt = Simplifier.the_context ss;
     7.7 -    val prems = prems_of_ss ss;
     7.8 +    val prems = Simplifier.prems_of ss;
     7.9      val ([t'], ctxt') = Variable.import_terms true [t] ctxt
    7.10      val export = singleton (Variable.export ctxt' ctxt)
    7.11  
     8.1 --- a/src/Provers/Arith/cancel_numerals.ML	Wed Jun 29 20:39:41 2011 +0200
     8.2 +++ b/src/Provers/Arith/cancel_numerals.ML	Wed Jun 29 21:34:16 2011 +0200
     8.3 @@ -68,7 +68,7 @@
     8.4  fun proc ss t =
     8.5    let
     8.6      val ctxt = Simplifier.the_context ss
     8.7 -    val prems = prems_of_ss ss
     8.8 +    val prems = Simplifier.prems_of ss
     8.9      val ([t'], ctxt') = Variable.import_terms true [t] ctxt
    8.10      val export = singleton (Variable.export ctxt' ctxt)
    8.11  
     9.1 --- a/src/Provers/Arith/extract_common_term.ML	Wed Jun 29 20:39:41 2011 +0200
     9.2 +++ b/src/Provers/Arith/extract_common_term.ML	Wed Jun 29 21:34:16 2011 +0200
     9.3 @@ -49,7 +49,7 @@
     9.4  fun proc ss t =
     9.5    let
     9.6      val ctxt = Simplifier.the_context ss;
     9.7 -    val prems = prems_of_ss ss;
     9.8 +    val prems = Simplifier.prems_of ss;
     9.9      val ([t'], ctxt') = Variable.import_terms true [t] ctxt
    9.10      val export = singleton (Variable.export ctxt' ctxt)
    9.11  
    10.1 --- a/src/Provers/Arith/fast_lin_arith.ML	Wed Jun 29 20:39:41 2011 +0200
    10.2 +++ b/src/Provers/Arith/fast_lin_arith.ML	Wed Jun 29 21:34:16 2011 +0200
    10.3 @@ -835,7 +835,7 @@
    10.4    end);
    10.5  
    10.6  fun cut_lin_arith_tac ss =
    10.7 -  cut_facts_tac (Simplifier.prems_of_ss ss) THEN'
    10.8 +  cut_facts_tac (Simplifier.prems_of ss) THEN'
    10.9    simpset_lin_arith_tac ss false;
   10.10  
   10.11  fun lin_arith_tac ctxt =
   10.12 @@ -916,7 +916,7 @@
   10.13  fun lin_arith_simproc ss concl =
   10.14    let
   10.15      val ctxt = Simplifier.the_context ss
   10.16 -    val thms = maps LA_Logic.atomize (Simplifier.prems_of_ss ss)
   10.17 +    val thms = maps LA_Logic.atomize (Simplifier.prems_of ss)
   10.18      val Hs = map Thm.prop_of thms
   10.19      val Tconcl = LA_Logic.mk_Trueprop concl
   10.20    in
    11.1 --- a/src/Pure/raw_simplifier.ML	Wed Jun 29 20:39:41 2011 +0200
    11.2 +++ b/src/Pure/raw_simplifier.ML	Wed Jun 29 21:34:16 2011 +0200
    11.3 @@ -37,7 +37,6 @@
    11.4    val make_simproc: {name: string, lhss: cterm list,
    11.5      proc: morphism -> simpset -> cterm -> thm option, identifier: thm list} -> simproc
    11.6    val mk_simproc: string -> cterm list -> (theory -> simpset -> term -> thm option) -> simproc
    11.7 -  val prems_of_ss: simpset -> thm list
    11.8    val addsimps: simpset * thm list -> simpset
    11.9    val delsimps: simpset * thm list -> simpset
   11.10    val addeqcongs: simpset * thm list -> simpset
   11.11 @@ -97,6 +96,7 @@
   11.12      subgoal_tac: simpset -> int -> tactic,
   11.13      loop_tacs: (string * (simpset -> int -> tactic)) list,
   11.14      solvers: solver list * solver list}
   11.15 +  val prems_of: simpset -> thm list
   11.16    val add_simp: thm -> simpset -> simpset
   11.17    val del_simp: thm -> simpset -> simpset
   11.18    val solver: simpset -> solver -> int -> tactic
   11.19 @@ -235,7 +235,7 @@
   11.20  fun map_simpset1 f (Simpset (r1, r2)) = Simpset (map_ss1 f r1, r2);
   11.21  fun map_simpset2 f (Simpset (r1, r2)) = Simpset (r1, map_ss2 f r2);
   11.22  
   11.23 -fun prems_of_ss (Simpset ({prems, ...}, _)) = prems;
   11.24 +fun prems_of (Simpset ({prems, ...}, _)) = prems;
   11.25  
   11.26  fun eq_procid ((s1: stamp, ths1: thm list), (s2, ths2)) =
   11.27    s1 = s2 andalso eq_list Thm.eq_thm (ths1, ths2);
   11.28 @@ -562,7 +562,7 @@
   11.29  
   11.30  fun is_full_cong thm =
   11.31    let
   11.32 -    val prems = prems_of thm and concl = concl_of thm;
   11.33 +    val prems = Thm.prems_of thm and concl = Thm.concl_of thm;
   11.34      val (lhs, rhs) = Logic.dest_equals concl;
   11.35      val (f, xs) = strip_comb lhs and (g, ys) = strip_comb rhs;
   11.36    in
   11.37 @@ -1278,7 +1278,7 @@
   11.38    in bottomc (mode, Option.map Drule.flexflex_unique oo prover, thy, maxidx) ss ct end;
   11.39  
   11.40  val simple_prover =
   11.41 -  SINGLE o (fn ss => ALLGOALS (resolve_tac (prems_of_ss ss)));
   11.42 +  SINGLE o (fn ss => ALLGOALS (resolve_tac (prems_of ss)));
   11.43  
   11.44  fun rewrite _ [] ct = Thm.reflexive ct
   11.45    | rewrite full thms ct = rewrite_cterm (full, false, false) simple_prover
    12.1 --- a/src/Pure/simplifier.ML	Wed Jun 29 20:39:41 2011 +0200
    12.2 +++ b/src/Pure/simplifier.ML	Wed Jun 29 21:34:16 2011 +0200
    12.3 @@ -34,6 +34,7 @@
    12.4    val pretty_ss: Proof.context -> simpset -> Pretty.T
    12.5    val clear_ss: simpset -> simpset
    12.6    val debug_bounds: bool Unsynchronized.ref
    12.7 +  val prems_of: simpset -> thm list
    12.8    val add_simp: thm -> simpset -> simpset
    12.9    val del_simp: thm -> simpset -> simpset
   12.10    val add_prems: thm list -> simpset -> simpset
   12.11 @@ -396,11 +397,13 @@
   12.12    let
   12.13      val trivialities = Drule.reflexive_thm :: trivs;
   12.14  
   12.15 -    fun unsafe_solver_tac ss = FIRST' [resolve_tac (trivialities @ prems_of_ss ss), assume_tac];
   12.16 +    fun unsafe_solver_tac ss =
   12.17 +      FIRST' [resolve_tac (trivialities @ Raw_Simplifier.prems_of ss), assume_tac];
   12.18      val unsafe_solver = mk_solver "easy unsafe" unsafe_solver_tac;
   12.19  
   12.20      (*no premature instantiation of variables during simplification*)
   12.21 -    fun safe_solver_tac ss = FIRST' [match_tac (trivialities @ prems_of_ss ss), eq_assume_tac];
   12.22 +    fun safe_solver_tac ss =
   12.23 +      FIRST' [match_tac (trivialities @ Raw_Simplifier.prems_of ss), eq_assume_tac];
   12.24      val safe_solver = mk_solver "easy safe" safe_solver_tac;
   12.25  
   12.26      fun mk_eq thm =
    13.1 --- a/src/Sequents/simpdata.ML	Wed Jun 29 20:39:41 2011 +0200
    13.2 +++ b/src/Sequents/simpdata.ML	Wed Jun 29 21:34:16 2011 +0200
    13.3 @@ -59,11 +59,11 @@
    13.4    @{thm iff_refl}, reflexive_thm];
    13.5  
    13.6  fun unsafe_solver ss =
    13.7 -  FIRST' [resolve_tac (triv_rls @ prems_of_ss ss), assume_tac];
    13.8 +  FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ss), assume_tac];
    13.9  
   13.10  (*No premature instantiation of variables during simplification*)
   13.11  fun safe_solver ss =
   13.12 - FIRST' [fn i => DETERM (match_tac (triv_rls @ prems_of_ss ss) i), eq_assume_tac];
   13.13 + FIRST' [fn i => DETERM (match_tac (triv_rls @ Simplifier.prems_of ss) i), eq_assume_tac];
   13.14  
   13.15  (*No simprules, but basic infrastructure for simplification*)
   13.16  val LK_basic_ss =
    14.1 --- a/src/ZF/Tools/inductive_package.ML	Wed Jun 29 20:39:41 2011 +0200
    14.2 +++ b/src/ZF/Tools/inductive_package.ML	Wed Jun 29 21:34:16 2011 +0200
    14.3 @@ -329,7 +329,7 @@
    14.4       val min_ss = Simplifier.global_context thy empty_ss
    14.5             setmksimps (K (map mk_eq o ZF_atomize o gen_all))
    14.6             setSolver (mk_solver "minimal"
    14.7 -                      (fn ss => resolve_tac (triv_rls @ prems_of_ss ss)
    14.8 +                      (fn ss => resolve_tac (triv_rls @ Simplifier.prems_of ss)
    14.9                                     ORELSE' assume_tac
   14.10                                     ORELSE' etac @{thm FalseE}));
   14.11  
    15.1 --- a/src/ZF/Tools/typechk.ML	Wed Jun 29 20:39:41 2011 +0200
    15.2 +++ b/src/ZF/Tools/typechk.ML	Wed Jun 29 21:34:16 2011 +0200
    15.3 @@ -107,7 +107,7 @@
    15.4  
    15.5  val type_solver =
    15.6    Simplifier.mk_solver "ZF typecheck" (fn ss =>
    15.7 -    type_solver_tac (Simplifier.the_context ss) (prems_of_ss ss));
    15.8 +    type_solver_tac (Simplifier.the_context ss) (Simplifier.prems_of ss));
    15.9  
   15.10  
   15.11  (* concrete syntax *)