src/ZF/simpdata.ML
author wenzelm
Sat, 13 Mar 2010 16:44:12 +0100
changeset 35762 af3ff2ba4c54
parent 35409 5c5bb83f2bae
child 36543 0e7fc5bf38de
permissions -rw-r--r--
removed old CVS Ids; tuned headers;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
35762
af3ff2ba4c54 removed old CVS Ids;
wenzelm
parents: 35409
diff changeset
     1
(*  Title:      ZF/simpdata.ML
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Copyright   1991  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
35762
af3ff2ba4c54 removed old CVS Ids;
wenzelm
parents: 35409
diff changeset
     5
Rewriting for ZF set theory: specialized extraction of rewrites from theorems.
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
12199
8213fd95acb5 miniscoping of UN and INT
paulson
parents: 11695
diff changeset
     8
(*** New version of mk_rew_rules ***)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
(*Should False yield False<->True, or should it solve goals some other way?*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    11
1036
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    12
(*Analyse a theorem to atomic rewrite rules*)
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    13
fun atomize (conn_pairs, mem_pairs) th =
1036
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    14
  let fun tryrules pairs t =
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    15
          case head_of t of
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    16
              Const(a,_) =>
17325
d9d50222808e introduced new-style AList operations
haftmann
parents: 17002
diff changeset
    17
                (case AList.lookup (op =) pairs a of
32952
aeb1e44fbc19 replaced String.concat by implode;
wenzelm
parents: 26499
diff changeset
    18
                     SOME rls => maps (atomize (conn_pairs, mem_pairs)) ([th] RL rls)
aeb1e44fbc19 replaced String.concat by implode;
wenzelm
parents: 26499
diff changeset
    19
                   | NONE => [th])
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    20
            | _ => [th]
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    21
  in case concl_of th of
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    22
         Const("Trueprop",_) $ P =>
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    23
            (case P of
24826
78e6a3cea367 avoid unnamed infixes;
wenzelm
parents: 18735
diff changeset
    24
                 Const(@{const_name mem},_) $ a $ b => tryrules mem_pairs b
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    25
               | Const("True",_)         => []
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    26
               | Const("False",_)        => []
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1036
diff changeset
    27
               | A => tryrules conn_pairs A)
1036
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    28
       | _                       => [th]
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    29
  end;
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    30
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
(*Analyse a rigid formula*)
1036
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    32
val ZF_conn_pairs =
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    33
  [("Ball",     [@{thm bspec}]),
35409
5c5bb83f2bae more antiquotations;
wenzelm
parents: 32952
diff changeset
    34
   ("All",      [@{thm spec}]),
5c5bb83f2bae more antiquotations;
wenzelm
parents: 32952
diff changeset
    35
   ("op -->",   [@{thm mp}]),
5c5bb83f2bae more antiquotations;
wenzelm
parents: 32952
diff changeset
    36
   ("op &",     [@{thm conjunct1}, @{thm conjunct2}])];
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    37
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
(*Analyse a:b, where b is rigid*)
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    39
val ZF_mem_pairs =
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    40
  [("Collect",  [@{thm CollectD1}, @{thm CollectD2}]),
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    41
   (@{const_name Diff},     [@{thm DiffD1}, @{thm DiffD2}]),
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    42
   (@{const_name Int},   [@{thm IntD1}, @{thm IntD2}])];
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    43
1036
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    44
val ZF_atomize = atomize (ZF_conn_pairs, ZF_mem_pairs);
0d28f4bc8a44 Recoded function atomize so that new ways of creating
lcp
parents: 855
diff changeset
    45
17876
b9c92f384109 change_claset/simpset;
wenzelm
parents: 17325
diff changeset
    46
change_simpset (fn ss =>
b9c92f384109 change_claset/simpset;
wenzelm
parents: 17325
diff changeset
    47
  ss setmksimps (map mk_eq o ZF_atomize o gen_all)
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    48
  addcongs [@{thm if_weak_cong}]);
12209
09bc6f8456b9 type_solver_tac: use TCSET' to refer to context of goal state (does
wenzelm
parents: 12199
diff changeset
    49
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    50
local
11233
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    51
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    52
val unfold_bex_tac = unfold_tac [@{thm Bex_def}];
18324
d1c4b1112e33 unfold_tac: static evaluation of simpset;
wenzelm
parents: 17876
diff changeset
    53
fun prove_bex_tac ss = unfold_bex_tac ss THEN Quantifier1.prove_one_point_ex_tac;
11233
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    54
val rearrange_bex = Quantifier1.rearrange_bex prove_bex_tac;
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    55
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    56
val unfold_ball_tac = unfold_tac [@{thm Ball_def}];
18324
d1c4b1112e33 unfold_tac: static evaluation of simpset;
wenzelm
parents: 17876
diff changeset
    57
fun prove_ball_tac ss = unfold_ball_tac ss THEN Quantifier1.prove_one_point_all_tac;
11233
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    58
val rearrange_ball = Quantifier1.rearrange_ball prove_ball_tac;
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    59
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    60
in
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    61
26499
b4db4e165758 functional theory setup -- requires linear access;
wenzelm
parents: 24893
diff changeset
    62
val defBEX_regroup = Simplifier.simproc (Theory.deref @{theory_ref})
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    63
  "defined BEX" ["EX x:A. P(x) & Q(x)"] rearrange_bex;
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    64
26499
b4db4e165758 functional theory setup -- requires linear access;
wenzelm
parents: 24893
diff changeset
    65
val defBALL_regroup = Simplifier.simproc (Theory.deref @{theory_ref})
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    66
  "defined BALL" ["ALL x:A. P(x) --> Q(x)"] rearrange_ball;
11233
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    67
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    68
end;
34c81a796ee3 the one-point rule for bounded quantifiers
paulson
parents: 9907
diff changeset
    69
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    70
Addsimprocs [defBALL_regroup, defBEX_regroup];
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12825
diff changeset
    71
12199
8213fd95acb5 miniscoping of UN and INT
paulson
parents: 11695
diff changeset
    72
24893
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    73
val ZF_ss = @{simpset};
b8ef7afe3a6b modernized specifications;
wenzelm
parents: 24826
diff changeset
    74