152 (case Thm.term_of ct of |
152 (case Thm.term_of ct of |
153 Const ("==>", _) $ _ $ _ => arg_conv cv ct |
153 Const ("==>", _) $ _ $ _ => arg_conv cv ct |
154 | _ => raise CTERM ("implies_concl_conv", [ct])); |
154 | _ => raise CTERM ("implies_concl_conv", [ct])); |
155 |
155 |
156 |
156 |
157 (* single rewrite step, cf. REWR_CONV in HOL *) |
157 (* single rewrite step |
158 |
158 beta-normalizes the rhs and takes care that lhs aconv ct *) |
159 fun rewr_conv rule ct = |
159 fun rewr_conv rule ct = |
160 let |
160 let |
161 val rule1 = Thm.incr_indexes (#maxidx (Thm.rep_cterm ct) + 1) rule; |
161 val rule1 = Thm.incr_indexes (#maxidx (Thm.rep_cterm ct) + 1) rule; |
162 val lhs = Thm.lhs_of rule1; |
162 val lhs = Thm.lhs_of rule1; |
163 val rule2 = Thm.rename_boundvars (Thm.term_of lhs) (Thm.term_of ct) rule1; |
163 val rule2 = Thm.rename_boundvars (Thm.term_of lhs) (Thm.term_of ct) rule1; |
164 in |
164 val rule3 = |
165 Drule.instantiate_normalize (Thm.match (lhs, ct)) rule2 |
165 Thm.instantiate (Thm.match (lhs, ct)) rule2 |
166 handle Pattern.MATCH => raise CTERM ("rewr_conv", [lhs, ct]) |
166 handle Pattern.MATCH => raise CTERM ("rewr_conv", [lhs, ct]) |
167 end; |
167 val rule4 = |
|
168 if term_of(Thm.lhs_of rule3) aconv term_of ct then rule3 |
|
169 else |
|
170 let val ceq = Thm.dest_fun2 (Thm.cprop_of rule3) |
|
171 in rule3 COMP Thm.trivial (Thm.mk_binop ceq ct (Thm.rhs_of rule3)) end |
|
172 in Thm.transitive rule4 (Thm.beta_conversion true (Thm.rhs_of rule4)) end |
168 |
173 |
169 fun rewrs_conv rules = first_conv (map rewr_conv rules); |
174 fun rewrs_conv rules = first_conv (map rewr_conv rules); |
170 |
175 |
171 |
176 |
172 (* conversions on HHF rules *) |
177 (* conversions on HHF rules *) |