| author | obua | 
| Sat, 11 Jun 2005 12:55:25 +0200 | |
| changeset 16361 | cb31cb768a6c | 
| parent 15570 | 8d8c70b41bab | 
| child 17002 | fb9261990ffe | 
| 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 | 
| 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 | 
| 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 | ||
| 15092 | 48 | val type_solver = | 
| 49 | mk_solver "types" (fn prems => TCSET' (fn tcset => type_solver_tac tcset prems)); | |
| 50 | ||
| 12209 
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
 wenzelm parents: 
12199diff
changeset | 51 | simpset_ref() := | 
| 12725 | 52 | 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: 
12199diff
changeset | 53 | addcongs [if_weak_cong] | 
| 15092 | 54 | setSolver type_solver; | 
| 12209 
09bc6f8456b9
type_solver_tac: use TCSET' to refer to context of goal state (does
 wenzelm parents: 
12199diff
changeset | 55 | |
| 2469 | 56 | |
| 12199 | 57 | |
| 13462 | 58 | local | 
| 11233 | 59 | |
| 13462 | 60 | val prove_bex_tac = rewtac Bex_def THEN Quantifier1.prove_one_point_ex_tac; | 
| 11233 | 61 | val rearrange_bex = Quantifier1.rearrange_bex prove_bex_tac; | 
| 62 | ||
| 13462 | 63 | val prove_ball_tac = rewtac Ball_def THEN Quantifier1.prove_one_point_all_tac; | 
| 11233 | 64 | val rearrange_ball = Quantifier1.rearrange_ball prove_ball_tac; | 
| 65 | ||
| 66 | in | |
| 67 | ||
| 13462 | 68 | val defBEX_regroup = Simplifier.simproc (Theory.sign_of (the_context ())) | 
| 69 | "defined BEX" ["EX x:A. P(x) & Q(x)"] rearrange_bex; | |
| 70 | ||
| 71 | val defBALL_regroup = Simplifier.simproc (Theory.sign_of (the_context ())) | |
| 72 | "defined BALL" ["ALL x:A. P(x) --> Q(x)"] rearrange_ball; | |
| 11233 | 73 | |
| 74 | end; | |
| 75 | ||
| 13462 | 76 | Addsimprocs [defBALL_regroup, defBEX_regroup]; | 
| 77 | ||
| 12199 | 78 | |
| 4091 | 79 | val ZF_ss = simpset(); |