src/Sequents/simpdata.ML
author wenzelm
Mon, 17 Oct 2005 23:10:13 +0200
changeset 17876 b9c92f384109
parent 17481 75166ebb619b
child 17892 62c397c17d18
permissions -rw-r--r--
change_claset/simpset;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     1
(*  Title:      Sequents/simpdata.ML
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     2
    ID:         $Id$
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     3
    Author:     Lawrence C Paulson
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     4
    Copyright   1999  University of Cambridge
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     5
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     6
Instantiation of the generic simplifier for LK
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     7
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     8
Borrows from the DC simplifier of Soren Heilmann.
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
     9
*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    10
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    11
(*** Rewrite rules ***)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    12
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    13
fun prove_fun s =
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    14
 (writeln s;
17481
75166ebb619b converted to Isar theory format;
wenzelm
parents: 12725
diff changeset
    15
  prove_goal (the_context ()) s
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    16
   (fn prems => [ (cut_facts_tac prems 1),
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    17
                  (fast_tac (pack() add_safes [subst]) 1) ]));
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    18
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    19
val conj_simps = map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    20
 ["|- P & True <-> P",      "|- True & P <-> P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    21
  "|- P & False <-> False", "|- False & P <-> False",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    22
  "|- P & P <-> P", "        |- P & P & Q <-> P & Q",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    23
  "|- P & ~P <-> False",    "|- ~P & P <-> False",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    24
  "|- (P & Q) & R <-> P & (Q & R)"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    25
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    26
val disj_simps = map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    27
 ["|- P | True <-> True",  "|- True | P <-> True",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    28
  "|- P | False <-> P",    "|- False | P <-> P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    29
  "|- P | P <-> P",        "|- P | P | Q <-> P | Q",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    30
  "|- (P | Q) | R <-> P | (Q | R)"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    31
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    32
val not_simps = map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    33
 ["|- ~ False <-> True",   "|- ~ True <-> False"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    34
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    35
val imp_simps = map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    36
 ["|- (P --> False) <-> ~P",       "|- (P --> True) <-> True",
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    37
  "|- (False --> P) <-> True",     "|- (True --> P) <-> P",
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    38
  "|- (P --> P) <-> True",         "|- (P --> ~P) <-> ~P"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    39
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    40
val iff_simps = map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    41
 ["|- (True <-> P) <-> P",         "|- (P <-> True) <-> P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    42
  "|- (P <-> P) <-> True",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    43
  "|- (False <-> P) <-> ~P",       "|- (P <-> False) <-> ~P"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    44
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    45
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    46
val quant_simps = map prove_fun
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    47
 ["|- (ALL x. P) <-> P",
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    48
  "|- (ALL x. x=t --> P(x)) <-> P(t)",
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    49
  "|- (ALL x. t=x --> P(x)) <-> P(t)",
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    50
  "|- (EX x. P) <-> P",
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    51
  "|- (EX x. x=t & P(x)) <-> P(t)",
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    52
  "|- (EX x. t=x & P(x)) <-> P(t)"];
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    53
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    54
(*** Miniscoping: pushing quantifiers in
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    55
     We do NOT distribute of ALL over &, or dually that of EX over |
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    56
     Baaz and Leitsch, On Skolemization and Proof Complexity (1994)
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    57
     show that this step can increase proof length!
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    58
***)
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    59
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    60
(*existential miniscoping*)
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    61
val ex_simps = map prove_fun
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    62
                   ["|- (EX x. P(x) & Q) <-> (EX x. P(x)) & Q",
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    63
                    "|- (EX x. P & Q(x)) <-> P & (EX x. Q(x))",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    64
                    "|- (EX x. P(x) | Q) <-> (EX x. P(x)) | Q",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    65
                    "|- (EX x. P | Q(x)) <-> P | (EX x. Q(x))",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    66
                    "|- (EX x. P(x) --> Q) <-> (ALL x. P(x)) --> Q",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    67
                    "|- (EX x. P --> Q(x)) <-> P --> (EX x. Q(x))"];
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    68
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    69
(*universal miniscoping*)
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    70
val all_simps = map prove_fun
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    71
                    ["|- (ALL x. P(x) & Q) <-> (ALL x. P(x)) & Q",
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    72
                     "|- (ALL x. P & Q(x)) <-> P & (ALL x. Q(x))",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    73
                     "|- (ALL x. P(x) --> Q) <-> (EX x. P(x)) --> Q",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    74
                     "|- (ALL x. P --> Q(x)) <-> P --> (ALL x. Q(x))",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    75
                     "|- (ALL x. P(x) | Q) <-> (ALL x. P(x)) | Q",
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    76
                     "|- (ALL x. P | Q(x)) <-> P | (ALL x. Q(x))"];
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
    77
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    78
(*These are NOT supplied by default!*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    79
val distrib_simps  = map prove_fun
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    80
 ["|- P & (Q | R) <-> P&Q | P&R",
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    81
  "|- (Q | R) & P <-> Q&P | R&P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    82
  "|- (P | Q --> R) <-> (P --> R) & (Q --> R)"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    83
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    84
(** Conversion into rewrite rules **)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    85
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    86
(*Make atomic rewrite rules*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    87
fun atomize r =
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    88
 case concl_of r of
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    89
   Const("Trueprop",_) $ Abs(_,_,a) $ Abs(_,_,c) =>
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
    90
     (case (forms_of_seq a, forms_of_seq c) of
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    91
        ([], [p]) =>
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    92
          (case p of
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    93
               Const("op -->",_)$_$_ => atomize(r RS mp_R)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    94
             | Const("op &",_)$_$_   => atomize(r RS conjunct1) @
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    95
                   atomize(r RS conjunct2)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    96
             | Const("All",_)$_      => atomize(r RS spec)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    97
             | Const("True",_)       => []    (*True is DELETED*)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    98
             | Const("False",_)      => []    (*should False do something?*)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
    99
             | _                     => [r])
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   100
      | _ => [])  (*ignore theorem unless it has precisely one conclusion*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   101
 | _ => [r];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   102
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   103
9259
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   104
Goal "|- ~P ==> |- (P <-> False)";
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   105
by (etac (thinR RS cut) 1);
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   106
by (Fast_tac 1);
9259
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   107
qed "P_iff_F";
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   108
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   109
val iff_reflection_F = P_iff_F RS iff_reflection;
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   110
9259
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   111
Goal "|- P ==> |- (P <-> True)";
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   112
by (etac (thinR RS cut) 1);
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   113
by (Fast_tac 1);
9259
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   114
qed "P_iff_T";
103acc345f75 removal of batch style, and tidying
paulson
parents: 7570
diff changeset
   115
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   116
val iff_reflection_T = P_iff_T RS iff_reflection;
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   117
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   118
(*Make meta-equalities.*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   119
fun mk_meta_eq th = case concl_of th of
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   120
    Const("==",_)$_$_           => th
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   121
  | Const("Trueprop",_) $ Abs(_,_,a) $ Abs(_,_,c) =>
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   122
        (case (forms_of_seq a, forms_of_seq c) of
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   123
             ([], [p]) =>
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   124
                 (case p of
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   125
                      (Const("op =",_)$_$_)   => th RS eq_reflection
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   126
                    | (Const("op <->",_)$_$_) => th RS iff_reflection
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   127
                    | (Const("Not",_)$_)      => th RS iff_reflection_F
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   128
                    | _                       => th RS iff_reflection_T)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   129
           | _ => error ("addsimps: unable to use theorem\n" ^
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   130
                         string_of_thm th));
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   131
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   132
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   133
(*Replace premises x=y, X<->Y by X==Y*)
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   134
val mk_meta_prems =
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   135
    rule_by_tactic
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   136
      (REPEAT_FIRST (resolve_tac [meta_eq_to_obj_eq, def_imp_iff]));
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   137
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   138
(*Congruence rules for = or <-> (instead of ==)*)
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   139
fun mk_meta_cong rl =
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   140
  standard(mk_meta_eq (mk_meta_prems rl))
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   141
  handle THM _ =>
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   142
  error("Premises and conclusion of congruence rules must use =-equality or <->");
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   143
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   144
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   145
(*** Named rewrite rules ***)
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   146
17481
75166ebb619b converted to Isar theory format;
wenzelm
parents: 12725
diff changeset
   147
fun prove nm thm  = qed_goal nm (the_context ()) thm
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   148
    (fn prems => [ (cut_facts_tac prems 1),
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   149
                   (fast_tac LK_pack 1) ]);
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   150
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   151
prove "conj_commute" "|- P&Q <-> Q&P";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   152
prove "conj_left_commute" "|- P&(Q&R) <-> Q&(P&R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   153
val conj_comms = [conj_commute, conj_left_commute];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   154
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   155
prove "disj_commute" "|- P|Q <-> Q|P";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   156
prove "disj_left_commute" "|- P|(Q|R) <-> Q|(P|R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   157
val disj_comms = [disj_commute, disj_left_commute];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   158
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   159
prove "conj_disj_distribL" "|- P&(Q|R) <-> (P&Q | P&R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   160
prove "conj_disj_distribR" "|- (P|Q)&R <-> (P&R | Q&R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   161
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   162
prove "disj_conj_distribL" "|- P|(Q&R) <-> (P|Q) & (P|R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   163
prove "disj_conj_distribR" "|- (P&Q)|R <-> (P|R) & (Q|R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   164
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   165
prove "imp_conj_distrib" "|- (P --> (Q&R)) <-> (P-->Q) & (P-->R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   166
prove "imp_conj"         "|- ((P&Q)-->R)   <-> (P --> (Q --> R))";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   167
prove "imp_disj"         "|- (P|Q --> R)   <-> (P-->R) & (Q-->R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   168
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   169
prove "imp_disj1" "|- (P-->Q) | R <-> (P-->Q | R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   170
prove "imp_disj2" "|- Q | (P-->R) <-> (P-->Q | R)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   171
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   172
prove "de_Morgan_disj" "|- (~(P | Q)) <-> (~P & ~Q)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   173
prove "de_Morgan_conj" "|- (~(P & Q)) <-> (~P | ~Q)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   174
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   175
prove "not_iff" "|- ~(P <-> Q) <-> (P <-> ~Q)";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   176
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   177
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   178
val [p1,p2] = Goal
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   179
    "[| |- P <-> P';  |- P' ==> |- Q <-> Q' |] ==> |- (P-->Q) <-> (P'-->Q')";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   180
by (lemma_tac p1 1);
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   181
by (Safe_tac 1);
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   182
by (REPEAT (rtac cut 1
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   183
            THEN
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   184
            DEPTH_SOLVE_1 (resolve_tac [thinL, thinR, p2 COMP monotonic] 1)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   185
            THEN
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   186
            Safe_tac 1));
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   187
qed "imp_cong";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   188
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   189
val [p1,p2] = Goal
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   190
    "[| |- P <-> P';  |- P' ==> |- Q <-> Q' |] ==> |- (P&Q) <-> (P'&Q')";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   191
by (lemma_tac p1 1);
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   192
by (Safe_tac 1);
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   193
by (REPEAT (rtac cut 1
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   194
            THEN
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   195
            DEPTH_SOLVE_1 (resolve_tac [thinL, thinR, p2 COMP monotonic] 1)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   196
            THEN
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   197
            Safe_tac 1));
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   198
qed "conj_cong";
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   199
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   200
Goal "|- (x=y) <-> (y=x)";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   201
by (fast_tac (pack() add_safes [subst]) 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   202
qed "eq_sym_conv";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   203
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   204
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   205
(** if-then-else rules **)
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   206
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   207
Goalw [If_def] "|- (if True then x else y) = x";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   208
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   209
qed "if_True";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   210
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   211
Goalw [If_def] "|- (if False then x else y) = y";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   212
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   213
qed "if_False";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   214
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   215
Goalw [If_def] "|- P ==> |- (if P then x else y) = x";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   216
by (etac (thinR RS cut) 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   217
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   218
qed "if_P";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   219
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   220
Goalw [If_def] "|- ~P ==> |- (if P then x else y) = y";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   221
by (etac (thinR RS cut) 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   222
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   223
qed "if_not_P";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   224
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   225
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   226
(*** Standard simpsets ***)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   227
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   228
val triv_rls = [FalseL, TrueR, basic, refl, iff_refl, reflexive_thm];
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   229
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   230
fun unsafe_solver prems = FIRST'[resolve_tac (triv_rls@prems),
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   231
                                 assume_tac];
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   232
(*No premature instantiation of variables during simplification*)
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   233
fun   safe_solver prems = FIRST'[fn i => DETERM (match_tac (triv_rls@prems) i),
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   234
                                 eq_assume_tac];
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   235
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   236
(*No simprules, but basic infrastructure for simplification*)
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   237
val LK_basic_ss =
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   238
  empty_ss setsubgoaler asm_simp_tac
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   239
    setSSolver (mk_solver "safe" safe_solver)
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   240
    setSolver (mk_solver "unsafe" unsafe_solver)
12725
7ede865e1fe5 renamed forall_elim_vars_safe to gen_all;
wenzelm
parents: 12720
diff changeset
   241
    setmksimps (map mk_meta_eq o atomize o gen_all)
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   242
    setmkcong mk_meta_cong;
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   243
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   244
val LK_simps =
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   245
   [triv_forall_equality, (* prunes params *)
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   246
    refl RS P_iff_T] @
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   247
    conj_simps @ disj_simps @ not_simps @
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   248
    imp_simps @ iff_simps @quant_simps @ all_simps @ ex_simps @
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   249
    [de_Morgan_conj, de_Morgan_disj, imp_disj1, imp_disj2] @
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   250
    map prove_fun
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   251
     ["|- P | ~P",             "|- ~P | P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   252
      "|- ~ ~ P <-> P",        "|- (~P --> P) <-> P",
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   253
      "|- (~P <-> ~Q) <-> (P<->Q)"];
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   254
9713
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   255
val LK_ss =
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   256
  LK_basic_ss addsimps LK_simps
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   257
  addeqcongs [left_cong]
2c5b42311eb0 cong setup now part of Simplifier;
wenzelm
parents: 9259
diff changeset
   258
  addcongs [imp_cong];
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   259
17876
b9c92f384109 change_claset/simpset;
wenzelm
parents: 17481
diff changeset
   260
change_simpset (fn _ => LK_ss);
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   261
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   262
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   263
(* To create substition rules *)
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   264
17481
75166ebb619b converted to Isar theory format;
wenzelm
parents: 12725
diff changeset
   265
qed_goal "eq_imp_subst" (the_context ()) "|- a=b ==> $H, A(a), $G |- $E, A(b), $F"
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   266
  (fn prems =>
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   267
   [cut_facts_tac prems 1,
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   268
    asm_simp_tac LK_basic_ss 1]);
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   269
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   270
Goal "|- P(if Q then x else y) <-> ((Q --> P(x)) & (~Q --> P(y)))";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   271
by (res_inst_tac [ ("P","Q") ] cut 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   272
by (simp_tac (simpset() addsimps [if_P]) 2);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   273
by (res_inst_tac [ ("P","~Q") ] cut 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   274
by (simp_tac (simpset() addsimps [if_not_P]) 2);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   275
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   276
qed "split_if";
7098
86583034aacf installation of simplifier and classical reasoner, better rules etc
paulson
parents:
diff changeset
   277
7123
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   278
Goal "|- (if P then x else x) = x";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   279
by (lemma_tac split_if 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   280
by (Fast_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   281
qed "if_cancel";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   282
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   283
Goal "|- (if x=y then y else x) = x";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   284
by (lemma_tac split_if 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   285
by (Safe_tac 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   286
by (rtac symL 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   287
by (rtac basic 1);
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   288
qed "if_eq_cancel";
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   289
4ab38de3fd20 congruence rule for |-, etc.
paulson
parents: 7098
diff changeset
   290
(*Putting in automatic case splits seems to require a lot of work.*)