ensured that rewr_conv rule t = "t == u" literally not just modulo beta-eta
authornipkow
Wed, 24 Oct 2012 17:40:56 +0200
changeset 50989791157a4179a
parent 50988 e84baadd4963
child 50990 faf4afed009f
ensured that rewr_conv rule t = "t == u" literally not just modulo beta-eta
src/Pure/conv.ML
     1.1 --- a/src/Pure/conv.ML	Mon Oct 22 22:47:14 2012 +0200
     1.2 +++ b/src/Pure/conv.ML	Wed Oct 24 17:40:56 2012 +0200
     1.3 @@ -154,17 +154,22 @@
     1.4    | _ => raise CTERM ("implies_concl_conv", [ct]));
     1.5  
     1.6  
     1.7 -(* single rewrite step, cf. REWR_CONV in HOL *)
     1.8 -
     1.9 +(* single rewrite step
    1.10 +   beta-normalizes the rhs and takes care that lhs aconv ct *)
    1.11  fun rewr_conv rule ct =
    1.12    let
    1.13      val rule1 = Thm.incr_indexes (#maxidx (Thm.rep_cterm ct) + 1) rule;
    1.14      val lhs = Thm.lhs_of rule1;
    1.15      val rule2 = Thm.rename_boundvars (Thm.term_of lhs) (Thm.term_of ct) rule1;
    1.16 -  in
    1.17 -    Drule.instantiate_normalize (Thm.match (lhs, ct)) rule2
    1.18 +    val rule3 =
    1.19 +      Thm.instantiate (Thm.match (lhs, ct)) rule2
    1.20        handle Pattern.MATCH => raise CTERM ("rewr_conv", [lhs, ct])
    1.21 -  end;
    1.22 +    val rule4 =
    1.23 +      if term_of(Thm.lhs_of rule3) aconv term_of ct then rule3
    1.24 +      else
    1.25 +        let val ceq = Thm.dest_fun2 (Thm.cprop_of rule3)
    1.26 +        in rule3 COMP Thm.trivial (Thm.mk_binop ceq ct (Thm.rhs_of rule3)) end
    1.27 +  in Thm.transitive rule4 (Thm.beta_conversion true (Thm.rhs_of rule4)) end
    1.28  
    1.29  fun rewrs_conv rules = first_conv (map rewr_conv rules);
    1.30