2 Author: Amine Chaieb, TU Muenchen |
2 Author: Amine Chaieb, TU Muenchen |
3 *) |
3 *) |
4 |
4 |
5 signature FERRACK_TAC = |
5 signature FERRACK_TAC = |
6 sig |
6 sig |
7 val trace: bool Unsynchronized.ref |
|
8 val linr_tac: Proof.context -> bool -> int -> tactic |
7 val linr_tac: Proof.context -> bool -> int -> tactic |
9 end |
8 end |
10 |
9 |
11 structure Ferrack_Tac = |
10 structure Ferrack_Tac: FERRACK_TAC = |
12 struct |
11 struct |
13 |
|
14 val trace = Unsynchronized.ref false; |
|
15 fun trace_msg s = if !trace then tracing s else (); |
|
16 |
12 |
17 val ferrack_ss = let val ths = [@{thm real_of_int_inject}, @{thm real_of_int_less_iff}, |
13 val ferrack_ss = let val ths = [@{thm real_of_int_inject}, @{thm real_of_int_less_iff}, |
18 @{thm real_of_int_le_iff}] |
14 @{thm real_of_int_le_iff}] |
19 in @{context} delsimps ths addsimps (map (fn th => th RS sym) ths) |
15 in @{context} delsimps ths addsimps (map (fn th => th RS sym) ths) |
20 end |> simpset_of; |
16 end |> simpset_of; |
21 |
17 |
22 val binarith = @{thms arith_simps} |
18 val binarith = @{thms arith_simps} |
23 val comp_arith = binarith @ @{thms simp_thms} |
19 val comp_arith = binarith @ @{thms simp_thms} |
24 |
20 |
25 val zdvd_int = @{thm zdvd_int}; |
21 fun prepare_for_linr q fm = |
26 val zdiff_int_split = @{thm zdiff_int_split}; |
|
27 val all_nat = @{thm all_nat}; |
|
28 val ex_nat = @{thm ex_nat}; |
|
29 val split_zdiv = @{thm split_zdiv}; |
|
30 val split_zmod = @{thm split_zmod}; |
|
31 val mod_div_equality' = @{thm mod_div_equality'}; |
|
32 val split_div' = @{thm split_div'}; |
|
33 val Suc_eq_plus1 = @{thm Suc_eq_plus1}; |
|
34 val imp_le_cong = @{thm imp_le_cong}; |
|
35 val conj_le_cong = @{thm conj_le_cong}; |
|
36 val mod_add_left_eq = @{thm mod_add_left_eq} RS sym; |
|
37 val mod_add_right_eq = @{thm mod_add_right_eq} RS sym; |
|
38 val nat_div_add_eq = @{thm div_add1_eq} RS sym; |
|
39 val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym; |
|
40 |
|
41 fun prepare_for_linr sg q fm = |
|
42 let |
22 let |
43 val ps = Logic.strip_params fm |
23 val ps = Logic.strip_params fm |
44 val hs = map HOLogic.dest_Trueprop (Logic.strip_assums_hyp fm) |
24 val hs = map HOLogic.dest_Trueprop (Logic.strip_assums_hyp fm) |
45 val c = HOLogic.dest_Trueprop (Logic.strip_assums_concl fm) |
25 val c = HOLogic.dest_Trueprop (Logic.strip_assums_concl fm) |
46 fun mk_all ((s, T), (P,n)) = |
26 fun mk_all ((s, T), (P,n)) = |
70 THEN' (REPEAT_DETERM o split_tac [@{thm split_min}, @{thm split_max}, @{thm abs_split}]) |
50 THEN' (REPEAT_DETERM o split_tac [@{thm split_min}, @{thm split_max}, @{thm abs_split}]) |
71 THEN' SUBGOAL (fn (g, i) => |
51 THEN' SUBGOAL (fn (g, i) => |
72 let |
52 let |
73 val thy = Proof_Context.theory_of ctxt |
53 val thy = Proof_Context.theory_of ctxt |
74 (* Transform the term*) |
54 (* Transform the term*) |
75 val (t,np,nh) = prepare_for_linr thy q g |
55 val (t,np,nh) = prepare_for_linr q g |
76 (* Some simpsets for dealing with mod div abs and nat*) |
56 (* Some simpsets for dealing with mod div abs and nat*) |
77 val simpset0 = put_simpset HOL_basic_ss ctxt addsimps comp_arith |
57 val simpset0 = put_simpset HOL_basic_ss ctxt addsimps comp_arith |
78 val ct = cterm_of thy (HOLogic.mk_Trueprop t) |
58 val ct = cterm_of thy (HOLogic.mk_Trueprop t) |
79 (* Theorem for the nat --> int transformation *) |
59 (* Theorem for the nat --> int transformation *) |
80 val pre_thm = Seq.hd (EVERY |
60 val pre_thm = Seq.hd (EVERY |
85 (* The result of the quantifier elimination *) |
65 (* The result of the quantifier elimination *) |
86 val (th, tac) = case prop_of pre_thm of |
66 val (th, tac) = case prop_of pre_thm of |
87 Const ("==>", _) $ (Const (@{const_name Trueprop}, _) $ t1) $ _ => |
67 Const ("==>", _) $ (Const (@{const_name Trueprop}, _) $ t1) $ _ => |
88 let val pth = linr_oracle (ctxt, Envir.eta_long [] t1) |
68 let val pth = linr_oracle (ctxt, Envir.eta_long [] t1) |
89 in |
69 in |
90 (trace_msg ("calling procedure with term:\n" ^ |
70 ((pth RS iffD2) RS pre_thm, |
91 Syntax.string_of_term ctxt t1); |
71 assm_tac (i + 1) THEN (if q then I else TRY) (rtac TrueI i)) |
92 ((pth RS iffD2) RS pre_thm, |
|
93 assm_tac (i + 1) THEN (if q then I else TRY) (rtac TrueI i))) |
|
94 end |
72 end |
95 | _ => (pre_thm, assm_tac i) |
73 | _ => (pre_thm, assm_tac i) |
96 in rtac ((mp_step nh o spec_step np) th) i THEN tac end); |
74 in rtac ((mp_step nh o spec_step np) th) i THEN tac end); |
97 |
75 |
98 end |
76 end |