Nominal/nominal_dt_rawfuns.ML
changeset 2308 387fcbd33820
parent 2305 93ab397f5980
child 2309 13f20fe02ff3
--- a/Nominal/nominal_dt_rawfuns.ML	Tue Jun 01 15:46:07 2010 +0200
+++ b/Nominal/nominal_dt_rawfuns.ML	Wed Jun 02 11:37:51 2010 +0200
@@ -226,6 +226,9 @@
   val all_fun_names = map (fn s => (Binding.name s, NONE, NoSyn)) (fv_names @ fv_bn_names)
   val all_fun_eqs = map (pair Attrib.empty_binding) (flat fv_eqs @ flat fv_bn_eqs)
 
+  val _ = tracing ("eqs\n" ^ cat_lines (map (Syntax.string_of_term lthy) ((flat fv_eqs) @ (flat fv_bn_eqs))))
+
+
   val (_, lthy') = Function.add_function all_fun_names all_fun_eqs
     Function_Common.default_config (pat_completeness_simp constr_thms) lthy
 
@@ -255,29 +258,31 @@
 end
 
 fun raw_prove_eqvt consts ind_thms simps ctxt =
-let 
-  val ([p], ctxt') = Variable.variant_fixes ["p"] ctxt
-  val p = Free (p, @{typ perm})
-  val arg_tys = 
-    consts
-    |> map fastype_of
-    |> map domain_type 
-  val (arg_names, ctxt'') = Variable.variant_fixes (replicate (length arg_tys) "") ctxt'
-  val args = map Free (arg_names ~~ arg_tys)
-  val goals = map2 (mk_eqvt_goal p) consts args
-  val insts = map (single o SOME) arg_names
-  val const_names = map (fst o dest_Const) consts
-  fun tac ctxt = 
-    Object_Logic.full_atomize_tac
-    THEN' InductTacs.induct_rules_tac ctxt insts ind_thms 
-    THEN_ALL_NEW   
-      (asm_full_simp_tac (HOL_basic_ss addsimps simps)
-       THEN' Nominal_Permeq.eqvt_tac ctxt simps const_names
-       THEN' asm_simp_tac HOL_basic_ss)
-in
-  Goal.prove_multi ctxt' [] [] goals (fn {context, ...} => (HEADGOAL (tac context)))
-  |> ProofContext.export ctxt'' ctxt
-end
+  if null consts then []
+  else
+    let 
+      val ([p], ctxt') = Variable.variant_fixes ["p"] ctxt
+      val p = Free (p, @{typ perm})
+      val arg_tys = 
+        consts
+        |> map fastype_of
+        |> map domain_type 
+      val (arg_names, ctxt'') = Variable.variant_fixes (replicate (length arg_tys) "") ctxt'
+      val args = map Free (arg_names ~~ arg_tys)
+      val goals = map2 (mk_eqvt_goal p) consts args
+      val insts = map (single o SOME) arg_names
+      val const_names = map (fst o dest_Const) consts
+      fun tac ctxt = 
+        Object_Logic.full_atomize_tac
+        THEN' InductTacs.induct_rules_tac ctxt insts ind_thms 
+        THEN_ALL_NEW   
+          (asm_full_simp_tac (HOL_basic_ss addsimps simps)
+           THEN' Nominal_Permeq.eqvt_tac ctxt simps const_names
+           THEN' asm_simp_tac HOL_basic_ss)
+    in
+      Goal.prove_multi ctxt' [] [] goals (fn {context, ...} => (HEADGOAL (tac context)))
+      |> ProofContext.export ctxt'' ctxt
+    end
 
 end (* structure *)