equal
deleted
inserted
replaced
11 signature CANCEL_SUMS_DATA = |
11 signature CANCEL_SUMS_DATA = |
12 sig |
12 sig |
13 (*abstract syntax*) |
13 (*abstract syntax*) |
14 val mk_sum: term list -> term |
14 val mk_sum: term list -> term |
15 val dest_sum: term -> term list |
15 val dest_sum: term -> term list |
|
16 val mk_plus: term * term -> term |
16 val mk_bal: term * term -> term |
17 val mk_bal: term * term -> term |
17 val dest_bal: term -> term * term |
18 val dest_bal: term -> term * term |
18 (*rules*) |
19 (*rules*) |
19 val prove_conv: tactic -> (simpset -> tactic) -> simpset -> term * term -> thm |
|
20 val norm_tac: simpset -> tactic (*AC0 etc.*) |
20 val norm_tac: simpset -> tactic (*AC0 etc.*) |
21 val uncancel_tac: cterm -> tactic (*apply A ~~ B == x + A ~~ x + B*) |
21 val cancel_rule: thm (* x + A ~~ x + B == A ~~ B *) |
22 end; |
22 end; |
23 |
23 |
24 signature CANCEL_SUMS = |
24 signature CANCEL_SUMS = |
25 sig |
25 sig |
26 val proc: simpset -> term -> thm option |
26 val proc: simpset -> term -> thm option |
44 EQUAL => cancel ts us (t :: vs) |
44 EQUAL => cancel ts us (t :: vs) |
45 | LESS => cons1 t (cancel ts (u :: us) vs) |
45 | LESS => cons1 t (cancel ts (u :: us) vs) |
46 | GREATER => cons2 u (cancel (t :: ts) us vs)); |
46 | GREATER => cons2 u (cancel (t :: ts) us vs)); |
47 |
47 |
48 |
48 |
49 (* uncancel *) |
|
50 |
|
51 fun uncancel_sums_tac _ [] = all_tac |
|
52 | uncancel_sums_tac thy (t :: ts) = |
|
53 Data.uncancel_tac (Thm.cterm_of thy t) THEN |
|
54 uncancel_sums_tac thy ts; |
|
55 |
|
56 |
|
57 (* the simplification procedure *) |
49 (* the simplification procedure *) |
58 |
50 |
59 fun proc ss t = |
51 fun proc ss t = |
60 (case try Data.dest_bal t of |
52 (case try Data.dest_bal t of |
61 NONE => NONE |
53 NONE => NONE |
64 val thy = Proof_Context.theory_of (Simplifier.the_context ss); |
56 val thy = Proof_Context.theory_of (Simplifier.the_context ss); |
65 val (ts, us) = pairself (sort Term_Ord.term_ord o Data.dest_sum) bal; |
57 val (ts, us) = pairself (sort Term_Ord.term_ord o Data.dest_sum) bal; |
66 val (ts', us', vs) = cancel ts us []; |
58 val (ts', us', vs) = cancel ts us []; |
67 in |
59 in |
68 if null vs then NONE |
60 if null vs then NONE |
69 else SOME |
61 else |
70 (Data.prove_conv (uncancel_sums_tac thy vs) Data.norm_tac ss |
62 let |
71 (t, Data.mk_bal (Data.mk_sum ts', Data.mk_sum us'))) |
63 val cert = Thm.cterm_of thy |
|
64 val t' = Data.mk_sum ts' |
|
65 val u' = Data.mk_sum us' |
|
66 val v = Data.mk_sum vs |
|
67 val t1 = Data.mk_bal (Data.mk_plus (v, t'), Data.mk_plus (v, u')) |
|
68 val t2 = Data.mk_bal (t', u') |
|
69 val goal1 = Thm.cterm_of thy (Logic.mk_equals (t, t1)) |
|
70 val goal2 = Thm.cterm_of thy (Logic.mk_equals (t1, t2)) |
|
71 val thm1 = Goal.prove_internal [] goal1 (K (Data.norm_tac ss)) |
|
72 val thm2 = Goal.prove_internal [] goal2 (K (rtac Data.cancel_rule 1)) |
|
73 in |
|
74 SOME (Thm.transitive thm1 thm2) |
|
75 end |
72 end); |
76 end); |
73 |
77 |
74 end; |
78 end; |