src/Provers/Arith/cancel_sums.ML
changeset 48372 868dc809c8a2
parent 42361 23f352990944
equal deleted inserted replaced
48371:3a5a5a992519 48372:868dc809c8a2
    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;