fixed the problem when giving a complex default-term; the fundef lemmas in Nominal_Base were not general enough
authorChristian Urban <urbanc@in.tum.de>
Tue, 14 Jun 2011 14:07:07 +0100
changeset 2848 da7e6655cd4c
parent 2847 5165f4552cd5
child 2849 31c338d562fd
child 2850 354a930ef18f
fixed the problem when giving a complex default-term; the fundef lemmas in Nominal_Base were not general enough
Nominal/Ex/TypeSchemes.thy
Nominal/Nominal2_Base.thy
Nominal/nominal_function_core.ML
--- a/Nominal/Ex/TypeSchemes.thy	Tue Jun 14 11:43:06 2011 +0100
+++ b/Nominal/Ex/TypeSchemes.thy	Tue Jun 14 14:07:07 2011 +0100
@@ -72,11 +72,9 @@
 using assms
 by blast
 
-definition "MYUNDEFINED \<equiv> undefined"
-
 --"The following is accepted by 'function' but not by 'nominal_primrec'"
 
-function (default "sum_case (\<lambda>x. Inl undefined) (\<lambda>x. Inr undefined)")
+nominal_primrec (default "sum_case (\<lambda>x. Inl undefined) (\<lambda>x. Inr undefined)")
     subst  :: "(name \<times> ty) list \<Rightarrow> ty \<Rightarrow> ty"
 and substs :: "(name \<times> ty) list \<Rightarrow> tys \<Rightarrow> tys"
 where
--- a/Nominal/Nominal2_Base.thy	Tue Jun 14 11:43:06 2011 +0100
+++ b/Nominal/Nominal2_Base.thy	Tue Jun 14 14:07:07 2011 +0100
@@ -1701,9 +1701,11 @@
   shows "Q (THE_default d P)"
 by (iprover intro: assms THE_defaultI')
 
+thm THE_default1_equality
+
 lemma the_default_eqvt:
   assumes unique: "\<exists>!x. P x"
-  shows "(p \<bullet> (THE_default d P)) = (THE_default d (p \<bullet> P))"
+  shows "(p \<bullet> (THE_default d P)) = (THE_default (p \<bullet> d) (p \<bullet> P))"
   apply(rule THE_default1_equality [symmetric])
   apply(rule_tac p="-p" in permute_boolE)
   apply(simp add: ex1_eqvt)
@@ -1716,21 +1718,37 @@
 
 lemma fundef_ex1_eqvt:
   fixes x::"'a::pt"
-  assumes f_def: "f == (\<lambda>x::'a. THE_default d (G x))"
+  assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (G x))"
   assumes eqvt: "eqvt G"
   assumes ex1: "\<exists>!y. G x y"
   shows "(p \<bullet> (f x)) = f (p \<bullet> x)"
   apply(simp only: f_def)
   apply(subst the_default_eqvt)
   apply(rule ex1)
+  apply(rule THE_default1_equality [symmetric])
+  apply(rule_tac p="-p" in permute_boolE)
+  apply(perm_simp add: permute_minus_cancel)
   using eqvt
   unfolding eqvt_def
-  apply(simp add: permute_fun_app_eq)
+  apply(simp)
+  apply(rule ex1)
+  apply(rule_tac p="-p" in permute_boolE)
+  apply(subst permute_fun_app_eq)
+  back
+  apply(subst the_default_eqvt)
+  apply(rule_tac p="-p" in permute_boolE)
+  apply(perm_simp add: permute_minus_cancel)
+  apply(rule ex1)
+  apply(perm_simp add: permute_minus_cancel)
+  using eqvt
+  unfolding eqvt_def
+  apply(simp)
+  apply(rule THE_defaultI'[OF ex1])
   done
 
 lemma fundef_ex1_eqvt_at:
   fixes x::"'a::pt"
-  assumes f_def: "f == (\<lambda>x::'a. THE_default d (G x))"
+  assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (G x))"
   assumes eqvt: "eqvt G"
   assumes ex1: "\<exists>!y. G x y"
   shows "eqvt_at f x"
@@ -1741,7 +1759,7 @@
 (* fixme: polish *)
 lemma fundef_ex1_prop:
   fixes x::"'a::pt"
-  assumes f_def: "f == (\<lambda>x::'a. THE_default d (G x))"
+  assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (G x))"
   assumes P_all: "\<And>x y. G x y \<Longrightarrow> P x y"
   assumes ex1: "\<exists>!y. G x y"
   shows "P x (f x)"
--- a/Nominal/nominal_function_core.ML	Tue Jun 14 11:43:06 2011 +0100
+++ b/Nominal/nominal_function_core.ML	Tue Jun 14 14:07:07 2011 +0100
@@ -290,6 +290,7 @@
     val ClauseContext {cqs=cqsj,ags=agsj,lhs=lhsj,case_hyp=case_hypj,...} = ctxj
 
     val lhsi_eq_lhsj = cterm_of thy (HOLogic.mk_Trueprop (mk_eq (lhsi, lhsj)))
+
   in if j < i then
     let
       val compat = lookup_compat_thm j i cts