src/HOL/SMT/Tools/smt_translate.ML
changeset 36889 6d1ecdb81ff0
parent 36885 48cf03469dc6
     1.1 --- a/src/HOL/SMT/Tools/smt_translate.ML	Wed May 12 23:54:00 2010 +0200
     1.2 +++ b/src/HOL/SMT/Tools/smt_translate.ML	Wed May 12 23:54:01 2010 +0200
     1.3 @@ -144,36 +144,24 @@
     1.4  val term_bool' = Simplifier.rewrite_rule [term_eq_rewr] term_bool
     1.5  
     1.6  
     1.7 -val is_let = (fn Const (@{const_name Let}, _) $ _ $ Abs _ => true | _ => false)
     1.8 -
     1.9 -val is_true_eq = (fn
    1.10 -    @{term "op = :: bool => _"} $ _ $ @{term True} => true
    1.11 +val needs_rewrite = Thm.prop_of #> Term.exists_subterm (fn
    1.12 +    Const (@{const_name Let}, _) => true
    1.13 +  | @{term "op = :: bool => _"} $ _ $ @{term True} => true
    1.14 +  | Const (@{const_name If}, _) $ _ $ @{term True} $ @{term False} => true
    1.15    | _ => false)
    1.16  
    1.17 -val true_eq_rewr = @{lemma "P = True == P" by simp}
    1.18 +val rewrite_rules = [
    1.19 +  Let_def,
    1.20 +  @{lemma "P = True == P" by (rule eq_reflection) simp},
    1.21 +  @{lemma "if P then True else False == P" by (rule eq_reflection) simp}]
    1.22  
    1.23 -val is_trivial_if = (fn
    1.24 -    Const (@{const_name If}, _) $ _ $ @{term True} $ @{term False} => true
    1.25 -  | _ => false)
    1.26 -
    1.27 -val trivial_if_rewr = @{lemma "(if P then True else False) == P"
    1.28 -  by (atomize(full)) simp}
    1.29 -
    1.30 -fun rewrite _ ct =
    1.31 -  if is_trivial_if (Thm.term_of ct) then Conv.rewr_conv trivial_if_rewr ct
    1.32 -  else if is_true_eq (Thm.term_of ct) then Conv.rewr_conv true_eq_rewr ct
    1.33 -  else if is_let (Thm.term_of ct) then Conv.rewr_conv @{thm Let_def} ct
    1.34 -  else Conv.all_conv ct
    1.35 -
    1.36 -val needs_rewrite =
    1.37 -  Term.exists_subterm (is_trivial_if orf is_true_eq orf is_let)
    1.38 +fun rewrite ctxt = Simplifier.full_rewrite
    1.39 +  (Simplifier.context ctxt empty_ss addsimps rewrite_rules)
    1.40  
    1.41  fun normalize ctxt thm =
    1.42 -  if needs_rewrite (Thm.prop_of thm)
    1.43 -  then Conv.fconv_rule (More_Conv.top_conv rewrite ctxt) thm
    1.44 -  else thm
    1.45 +  if needs_rewrite thm then Conv.fconv_rule (rewrite ctxt) thm else thm
    1.46  
    1.47 -val unfold_rules = [term_eq_rewr, Let_def, trivial_if_rewr, true_eq_rewr]
    1.48 +val unfold_rules = term_eq_rewr :: rewrite_rules
    1.49  
    1.50  
    1.51  val revert_types =