src/FOL/simpdata.ML
changeset 51717 9e7d1c139569
parent 45659 09539cdffcd7
child 54998 8601434fa334
equal deleted inserted replaced
51709:19b47bfac6ef 51717:9e7d1c139569
    24 fun mk_meta_prems ctxt =
    24 fun mk_meta_prems ctxt =
    25     rule_by_tactic ctxt
    25     rule_by_tactic ctxt
    26       (REPEAT_FIRST (resolve_tac [@{thm meta_eq_to_obj_eq}, @{thm def_imp_iff}]));
    26       (REPEAT_FIRST (resolve_tac [@{thm meta_eq_to_obj_eq}, @{thm def_imp_iff}]));
    27 
    27 
    28 (*Congruence rules for = or <-> (instead of ==)*)
    28 (*Congruence rules for = or <-> (instead of ==)*)
    29 fun mk_meta_cong ss rl =
    29 fun mk_meta_cong ctxt rl =
    30   Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems (Simplifier.the_context ss) rl))
    30   Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems ctxt rl))
    31     handle THM _ =>
    31     handle THM _ =>
    32       error("Premises and conclusion of congruence rules must use =-equality or <->");
    32       error("Premises and conclusion of congruence rules must use =-equality or <->");
    33 
    33 
    34 val mksimps_pairs =
    34 val mksimps_pairs =
    35   [(@{const_name imp}, [@{thm mp}]), (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]),
    35   [(@{const_name imp}, [@{thm mp}]), (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]),
    46                    | NONE => [th])
    46                    | NONE => [th])
    47               | _ => [th])
    47               | _ => [th])
    48          | _ => [th])
    48          | _ => [th])
    49   in atoms end;
    49   in atoms end;
    50 
    50 
    51 fun mksimps pairs (_: simpset) = map mk_eq o mk_atomize pairs o gen_all;
    51 fun mksimps pairs (_: Proof.context) = map mk_eq o mk_atomize pairs o gen_all;
    52 
    52 
    53 
    53 
    54 (** make simplification procedures for quantifier elimination **)
    54 (** make simplification procedures for quantifier elimination **)
    55 structure Quantifier1 = Quantifier1
    55 structure Quantifier1 = Quantifier1
    56 (
    56 (
   104 
   104 
   105 (*** Standard simpsets ***)
   105 (*** Standard simpsets ***)
   106 
   106 
   107 val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}];
   107 val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}];
   108 
   108 
   109 fun unsafe_solver ss =
   109 fun unsafe_solver ctxt =
   110   FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ss), atac, etac @{thm FalseE}];
   110   FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ctxt), atac, etac @{thm FalseE}];
   111 
   111 
   112 (*No premature instantiation of variables during simplification*)
   112 (*No premature instantiation of variables during simplification*)
   113 fun safe_solver ss =
   113 fun safe_solver ctxt =
   114   FIRST' [match_tac (triv_rls @ Simplifier.prems_of ss), eq_assume_tac, ematch_tac @{thms FalseE}];
   114   FIRST' [match_tac (triv_rls @ Simplifier.prems_of ctxt), eq_assume_tac, ematch_tac @{thms FalseE}];
   115 
   115 
   116 (*No simprules, but basic infastructure for simplification*)
   116 (*No simprules, but basic infastructure for simplification*)
   117 val FOL_basic_ss =
   117 val FOL_basic_ss =
   118   Simplifier.global_context @{theory} empty_ss
   118   empty_simpset @{context}
   119   setSSolver (mk_solver "FOL safe" safe_solver)
   119   setSSolver (mk_solver "FOL safe" safe_solver)
   120   setSolver (mk_solver "FOL unsafe" unsafe_solver)
   120   setSolver (mk_solver "FOL unsafe" unsafe_solver)
   121   |> Simplifier.set_subgoaler asm_simp_tac
   121   |> Simplifier.set_subgoaler asm_simp_tac
   122   |> Simplifier.set_mksimps (mksimps mksimps_pairs)
   122   |> Simplifier.set_mksimps (mksimps mksimps_pairs)
   123   |> Simplifier.set_mkcong mk_meta_cong;
   123   |> Simplifier.set_mkcong mk_meta_cong
       
   124   |> simpset_of;
   124 
   125 
   125 fun unfold_tac ths =
   126 fun unfold_tac ths ctxt =
   126   let val ss0 = Simplifier.clear_ss FOL_basic_ss addsimps ths
   127   ALLGOALS (full_simp_tac (clear_simpset (put_simpset FOL_basic_ss ctxt) addsimps ths));
   127   in fn ss => ALLGOALS (full_simp_tac (Simplifier.inherit_context ss ss0)) end;
       
   128 
   128 
   129 
   129 
   130 (*** integration of simplifier with classical reasoner ***)
   130 (*** integration of simplifier with classical reasoner ***)
   131 
   131 
   132 structure Clasimp = Clasimp
   132 structure Clasimp = Clasimp