src/Provers/Arith/combine_numerals.ML
author haftmann
Sat Sep 17 15:08:55 2011 +0200 (2011-09-17)
changeset 44947 8ae418dfe561
parent 35762 af3ff2ba4c54
child 51717 9e7d1c139569
permissions -rw-r--r--
dropped unused argument – avoids problem with SML/NJ
paulson@8774
     1
(*  Title:      Provers/Arith/combine_numerals.ML
paulson@8774
     2
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
paulson@8774
     3
    Copyright   2000  University of Cambridge
paulson@8774
     4
paulson@8774
     5
Combine coefficients in expressions:
paulson@8774
     6
paulson@8774
     7
     i + #m*u + j ... + #n*u + k  ==  #(m+n)*u + (i + (j + k))
paulson@8774
     8
paulson@8774
     9
It works by (a) massaging the sum to bring the selected terms to the front:
paulson@8774
    10
paulson@8774
    11
     #m*u + (#n*u + (i + (j + k)))
paulson@8774
    12
paulson@8774
    13
(b) then using left_distrib to reach
paulson@8774
    14
paulson@8774
    15
     #(m+n)*u + (i + (j + k))
paulson@8774
    16
*)
paulson@8774
    17
paulson@8774
    18
signature COMBINE_NUMERALS_DATA =
paulson@8774
    19
sig
paulson@8774
    20
  (*abstract syntax*)
huffman@23058
    21
  eqtype coeff
huffman@23058
    22
  val iszero: coeff -> bool
huffman@23058
    23
  val add: coeff * coeff -> coeff     (*addition (or multiplication) *)
paulson@14387
    24
  val mk_sum: typ -> term list -> term
paulson@8774
    25
  val dest_sum: term -> term list
huffman@23058
    26
  val mk_coeff: coeff * term -> term
huffman@23058
    27
  val dest_coeff: term -> coeff * term
paulson@8774
    28
  (*rules*)
paulson@8774
    29
  val left_distrib: thm
paulson@8774
    30
  (*proof tools*)
wenzelm@20114
    31
  val prove_conv: tactic list -> Proof.context -> term * term -> thm option
haftmann@44947
    32
  val trans_tac: thm option -> tactic            (*applies the initial lemma*)
wenzelm@16973
    33
  val norm_tac: simpset -> tactic                (*proves the initial lemma*)
wenzelm@16973
    34
  val numeral_simp_tac: simpset -> tactic        (*proves the final theorem*)
wenzelm@16973
    35
  val simplify_meta_eq: simpset -> thm -> thm    (*simplifies the final theorem*)
paulson@8774
    36
end;
paulson@8774
    37
paulson@8774
    38
paulson@8774
    39
functor CombineNumeralsFun(Data: COMBINE_NUMERALS_DATA):
paulson@8774
    40
  sig
wenzelm@20044
    41
  val proc: simpset -> term -> thm option
wenzelm@20114
    42
  end
paulson@8774
    43
=
paulson@8774
    44
struct
paulson@8774
    45
paulson@8774
    46
(*Remove the first occurrence of #m*u from the term list*)
paulson@8774
    47
fun remove (_, _, []) = (*impossible, since #m*u was found by find_repeated*)
wenzelm@20114
    48
      raise TERM("combine_numerals: remove", [])
paulson@8774
    49
  | remove (m, u, t::terms) =
paulson@9646
    50
      case try Data.dest_coeff t of
wenzelm@20114
    51
          SOME(n,v) => if m=n andalso u aconv v then terms
wenzelm@20114
    52
                       else t :: remove (m, u, terms)
wenzelm@20114
    53
        | NONE      =>  t :: remove (m, u, terms);
paulson@8774
    54
paulson@8774
    55
(*a left-to-right scan of terms, seeking another term of the form #n*u, where
paulson@8774
    56
  #m*u is already in terms for some m*)
wenzelm@20114
    57
fun find_repeated (tab, _, []) = raise TERM("find_repeated", [])
paulson@8774
    58
  | find_repeated (tab, past, t::terms) =
paulson@9646
    59
      case try Data.dest_coeff t of
wenzelm@20114
    60
          SOME(n,u) =>
wenzelm@20114
    61
              (case Termtab.lookup tab u of
wenzelm@20114
    62
                  SOME m => (u, m, n, rev (remove (m,u,past)) @ terms)
wenzelm@20114
    63
                | NONE => find_repeated (Termtab.update (u, n) tab,
wenzelm@20114
    64
                                         t::past,  terms))
wenzelm@20114
    65
        | NONE => find_repeated (tab, t::past, terms);
paulson@8774
    66
paulson@8774
    67
(*the simplification procedure*)
wenzelm@20044
    68
fun proc ss t =
wenzelm@20044
    69
  let
wenzelm@20114
    70
    val ctxt = Simplifier.the_context ss;
wenzelm@20114
    71
    val ([t'], ctxt') = Variable.import_terms true [t] ctxt
wenzelm@20114
    72
    val export = singleton (Variable.export ctxt' ctxt)
wenzelm@20114
    73
wenzelm@20114
    74
    val (u,m,n,terms) = find_repeated (Termtab.empty, [], Data.dest_sum t')
wenzelm@20114
    75
    val T = Term.fastype_of u
wenzelm@20114
    76
wenzelm@20114
    77
    val reshape =  (*Move i*u to the front and put j*u into standard form
wenzelm@20114
    78
                       i + #m + j + k == #m + i + (j + k) *)
huffman@23058
    79
      if Data.iszero m orelse Data.iszero n then   (*trivial, so do nothing*)
wenzelm@20114
    80
        raise TERM("combine_numerals", [])
wenzelm@20114
    81
      else Data.prove_conv [Data.norm_tac ss] ctxt
wenzelm@20114
    82
        (t', Data.mk_sum T ([Data.mk_coeff (m, u), Data.mk_coeff (n, u)] @ terms))
paulson@8774
    83
  in
wenzelm@20114
    84
    Option.map (export o Data.simplify_meta_eq ss)
wenzelm@20114
    85
      (Data.prove_conv
haftmann@44947
    86
         [Data.trans_tac reshape, rtac Data.left_distrib 1,
wenzelm@20114
    87
          Data.numeral_simp_tac ss] ctxt
wenzelm@20114
    88
         (t', Data.mk_sum T (Data.mk_coeff(Data.add(m,n), u) :: terms)))
paulson@8774
    89
  end
wenzelm@20114
    90
  (* FIXME avoid handling of generic exceptions *)
skalberg@15531
    91
  handle TERM _ => NONE
skalberg@15531
    92
       | TYPE _ => NONE;   (*Typically (if thy doesn't include Numeral)
wenzelm@20114
    93
                             Undeclared type constructor "Numeral.bin"*)
paulson@8774
    94
paulson@8774
    95
end;