| author | nipkow |
| Fri, 07 Feb 2003 15:36:12 +0100 | |
| changeset 13808 | f67a53bf63bc |
| 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(); |