| author | wenzelm | 
| Tue, 29 Sep 2009 23:19:26 +0200 | |
| changeset 32768 | e4a3f9c3d4f5 | 
| parent 26499 | b4db4e165758 | 
| child 32952 | aeb1e44fbc19 | 
| 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,_) =>  | 
| 17325 | 18  | 
(case AList.lookup (op =) pairs a of  | 
| 15570 | 19  | 
SOME rls => List.concat (map (atomize (conn_pairs, mem_pairs))  | 
| 1461 | 20  | 
([th] RL rls))  | 
| 15531 | 21  | 
| NONE => [th])  | 
| 1461 | 22  | 
| _ => [th]  | 
| 13462 | 23  | 
in case concl_of th of  | 
24  | 
         Const("Trueprop",_) $ P =>
 | 
|
| 1461 | 25  | 
(case P of  | 
| 24826 | 26  | 
                 Const(@{const_name mem},_) $ a $ b => tryrules mem_pairs b
 | 
| 1461 | 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 =  | 
| 24893 | 35  | 
  [("Ball",     [@{thm 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 =  | 
| 24893 | 42  | 
  [("Collect",  [@{thm CollectD1}, @{thm CollectD2}]),
 | 
43  | 
   (@{const_name Diff},     [@{thm DiffD1}, @{thm DiffD2}]),
 | 
|
44  | 
   (@{const_name Int},   [@{thm IntD1}, @{thm IntD2}])];
 | 
|
| 0 | 45  | 
|
| 1036 | 46  | 
val ZF_atomize = atomize (ZF_conn_pairs, ZF_mem_pairs);  | 
47  | 
||
| 17876 | 48  | 
change_simpset (fn ss =>  | 
49  | 
ss setmksimps (map mk_eq o ZF_atomize o gen_all)  | 
|
| 24893 | 50  | 
  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
 | 
51  | 
|
| 13462 | 52  | 
local  | 
| 11233 | 53  | 
|
| 24893 | 54  | 
val unfold_bex_tac = unfold_tac [@{thm Bex_def}];
 | 
| 18324 | 55  | 
fun prove_bex_tac ss = unfold_bex_tac ss THEN Quantifier1.prove_one_point_ex_tac;  | 
| 11233 | 56  | 
val rearrange_bex = Quantifier1.rearrange_bex prove_bex_tac;  | 
57  | 
||
| 24893 | 58  | 
val unfold_ball_tac = unfold_tac [@{thm Ball_def}];
 | 
| 18324 | 59  | 
fun prove_ball_tac ss = unfold_ball_tac ss THEN Quantifier1.prove_one_point_all_tac;  | 
| 11233 | 60  | 
val rearrange_ball = Quantifier1.rearrange_ball prove_ball_tac;  | 
61  | 
||
62  | 
in  | 
|
63  | 
||
| 
26499
 
b4db4e165758
functional theory setup -- requires linear access;
 
wenzelm 
parents: 
24893 
diff
changeset
 | 
64  | 
val defBEX_regroup = Simplifier.simproc (Theory.deref @{theory_ref})
 | 
| 13462 | 65  | 
"defined BEX" ["EX x:A. P(x) & Q(x)"] rearrange_bex;  | 
66  | 
||
| 
26499
 
b4db4e165758
functional theory setup -- requires linear access;
 
wenzelm 
parents: 
24893 
diff
changeset
 | 
67  | 
val defBALL_regroup = Simplifier.simproc (Theory.deref @{theory_ref})
 | 
| 13462 | 68  | 
"defined BALL" ["ALL x:A. P(x) --> Q(x)"] rearrange_ball;  | 
| 11233 | 69  | 
|
70  | 
end;  | 
|
71  | 
||
| 13462 | 72  | 
Addsimprocs [defBALL_regroup, defBEX_regroup];  | 
73  | 
||
| 12199 | 74  | 
|
| 24893 | 75  | 
val ZF_ss = @{simpset};
 | 
76  |