diff -r add799cf0817 -r 82e37a4595c7 Nominal-General/nominal_library.ML --- a/Nominal-General/nominal_library.ML Wed Nov 10 13:46:21 2010 +0000 +++ b/Nominal-General/nominal_library.ML Fri Nov 12 01:20:53 2010 +0000 @@ -258,22 +258,37 @@ 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 natT = @{typ nat} + fun prod_size_const fT sT = + let + val fT_fun = fT --> natT + val sT_fun = sT --> natT + val prodT = Type (@{type_name prod}, [fT, sT]) + in + Const (@{const_name prod_size}, [fT_fun, sT_fun, prodT] ---> natT) + end + + fun mk_size_measure T = + case T of + (Type (@{type_name Sum_Type.sum}, [fT, sT])) => + SumTree.mk_sumcase fT sT natT (mk_size_measure fT) (mk_size_measure sT) + | (Type (@{type_name Product_Type.prod}, [fT, sT])) => + prod_size_const fT sT $ (mk_size_measure fT) $ (mk_size_measure sT) + | _ => size_const T fun mk_measure_trm T = HOLogic.dest_setT T |> fst o HOLogic.dest_prodT |> mk_size_measure - |> curry (op $) (Const (@{const_name measure}, dummyT)) + |> 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 + zero_less_Suc prod.size(1) mult_Suc_right} @ size_simps + val ss' = ss addsimprocs Nat_Numeral_Simprocs.cancel_numerals in Function_Relation.relation_tac ctxt mk_measure_trm - THEN_ALL_NEW simp_tac ss + THEN_ALL_NEW simp_tac ss' end fun prove_termination size_simps ctxt =