author | schirmer |
Thu, 15 Apr 2004 09:33:12 +0200 | |
changeset 14567 | 03a827b7dbe8 |
parent 13780 | af7b79271364 |
child 15092 | 7fe7f022476c |
permissions | -rw-r--r-- |
0 | 1 |
(* Title: ZF/simpdata |
2 |
ID: $Id$ |
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
4 |
Copyright 1991 University of Cambridge |
|
5 |
||
2469 | 6 |
Rewriting for ZF set theory: specialized extraction of rewrites from theorems |
0 | 7 |
*) |
8 |
||
12199 | 9 |
(*** New version of mk_rew_rules ***) |
0 | 10 |
|
11 |
(*Should False yield False<->True, or should it solve goals some other way?*) |
|
12 |
||
1036 | 13 |
(*Analyse a theorem to atomic rewrite rules*) |
13462 | 14 |
fun atomize (conn_pairs, mem_pairs) th = |
1036 | 15 |
let fun tryrules pairs t = |
1461 | 16 |
case head_of t of |
13462 | 17 |
Const(a,_) => |
1461 | 18 |
(case assoc(pairs,a) of |
19 |
Some rls => flat (map (atomize (conn_pairs, mem_pairs)) |
|
20 |
([th] RL rls)) |
|
21 |
| None => [th]) |
|
22 |
| _ => [th] |
|
13462 | 23 |
in case concl_of th of |
24 |
Const("Trueprop",_) $ P => |
|
1461 | 25 |
(case P of |
26 |
Const("op :",_) $ a $ b => tryrules mem_pairs b |
|
27 |
| Const("True",_) => [] |
|
28 |
| Const("False",_) => [] |
|
29 |
| A => tryrules conn_pairs A) |
|
1036 | 30 |
| _ => [th] |
31 |
end; |
|
32 |
||
0 | 33 |
(*Analyse a rigid formula*) |
1036 | 34 |
val ZF_conn_pairs = |
13462 | 35 |
[("Ball", [bspec]), |
1461 | 36 |
("All", [spec]), |
37 |
("op -->", [mp]), |
|
38 |
("op &", [conjunct1,conjunct2])]; |
|
0 | 39 |
|
40 |
(*Analyse a:b, where b is rigid*) |
|
13462 | 41 |
val ZF_mem_pairs = |
1461 | 42 |
[("Collect", [CollectD1,CollectD2]), |
43 |
("op -", [DiffD1,DiffD2]), |
|
44 |
("op Int", [IntD1,IntD2])]; |
|
0 | 45 |
|
1036 | 46 |
val ZF_atomize = atomize (ZF_conn_pairs, ZF_mem_pairs); |
47 |
||
12209
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
wenzelm
parents:
12199
diff
changeset
|
48 |
simpset_ref() := |
12725 | 49 |
simpset() setmksimps (map mk_eq o ZF_atomize o gen_all) |
12209
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
wenzelm
parents:
12199
diff
changeset
|
50 |
addcongs [if_weak_cong] |
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
wenzelm
parents:
12199
diff
changeset
|
51 |
setSolver (mk_solver "types" (fn prems => TCSET' (fn tcset => type_solver_tac tcset prems))); |
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
wenzelm
parents:
12199
diff
changeset
|
52 |
|
2469 | 53 |
|
12199 | 54 |
|
13462 | 55 |
local |
11233 | 56 |
|
13462 | 57 |
val prove_bex_tac = rewtac Bex_def THEN Quantifier1.prove_one_point_ex_tac; |
11233 | 58 |
val rearrange_bex = Quantifier1.rearrange_bex prove_bex_tac; |
59 |
||
13462 | 60 |
val prove_ball_tac = rewtac Ball_def THEN Quantifier1.prove_one_point_all_tac; |
11233 | 61 |
val rearrange_ball = Quantifier1.rearrange_ball prove_ball_tac; |
62 |
||
63 |
in |
|
64 |
||
13462 | 65 |
val defBEX_regroup = Simplifier.simproc (Theory.sign_of (the_context ())) |
66 |
"defined BEX" ["EX x:A. P(x) & Q(x)"] rearrange_bex; |
|
67 |
||
68 |
val defBALL_regroup = Simplifier.simproc (Theory.sign_of (the_context ())) |
|
69 |
"defined BALL" ["ALL x:A. P(x) --> Q(x)"] rearrange_ball; |
|
11233 | 70 |
|
71 |
end; |
|
72 |
||
13462 | 73 |
Addsimprocs [defBALL_regroup, defBEX_regroup]; |
74 |
||
12199 | 75 |
|
4091 | 76 |
val ZF_ss = simpset(); |