Nominal-General/nominal_library.ML
changeset 2560 82e37a4595c7
parent 2559 add799cf0817
--- 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 =