--- a/Nominal-General/nominal_library.ML Wed Nov 10 13:40:46 2010 +0000
+++ b/Nominal-General/nominal_library.ML Wed Nov 10 13:46:21 2010 +0000
@@ -256,46 +256,24 @@
end
-(** FIX: my_relation is necessary because of problem in Function Package *)
-
-fun inst_state_tac ctxt rel st =
- let
- val cert = Thm.cterm_of (ProofContext.theory_of ctxt)
- val rel' = cert (singleton (Variable.polymorphic ctxt) rel)
- val st' = Thm.incr_indexes (#maxidx (Thm.rep_cterm rel') + 1) st
- in case Term.add_vars (prop_of st') [] of
- [v] =>
- PRIMITIVE (Drule.cterm_instantiate [(cert (Var v), rel')]) st'
- | _ => Seq.empty
- end
-
-fun my_relation_tac ctxt rel i =
- TRY (Function_Common.apply_termination_rule ctxt i)
- THEN inst_state_tac ctxt rel
-
-(** FIX: end *)
-
-
-fun prove_termination_tac size_simps ctxt i st =
+fun prove_termination_tac size_simps ctxt =
let
fun mk_size_measure (Type (@{type_name Sum_Type.sum}, [fT, sT])) =
SumTree.mk_sumcase fT sT @{typ nat} (mk_size_measure fT) (mk_size_measure sT)
| mk_size_measure T = size_const T
- val ((_ $ (_ $ rel)) :: _) = prems_of st
- val measure_trm =
- fastype_of rel
- |> HOLogic.dest_setT
+ fun mk_measure_trm T =
+ HOLogic.dest_setT T
+ |> fst o HOLogic.dest_prodT
|> mk_size_measure
|> curry (op $) (Const (@{const_name measure}, dummyT))
|> Syntax.check_term ctxt
+
val ss = HOL_ss addsimps @{thms in_measure wf_measure sum.cases add_Suc_right add.right_neutral
zero_less_Suc} @ size_simps addsimprocs Nat_Numeral_Simprocs.cancel_numerals
-
in
- (*see above Function_Relation.relation_tac ctxt measure_trm*)
- (my_relation_tac ctxt measure_trm
- THEN_ALL_NEW simp_tac ss) i st
+ Function_Relation.relation_tac ctxt mk_measure_trm
+ THEN_ALL_NEW simp_tac ss
end
fun prove_termination size_simps ctxt =