# HG changeset patch # User Christian Urban # Date 1308056827 -3600 # Node ID da7e6655cd4c0fa675908ccbdea2300766684e2a # Parent 5165f4552cd58ade8b0fa3740bc7668359e3f9dc fixed the problem when giving a complex default-term; the fundef lemmas in Nominal_Base were not general enough diff -r 5165f4552cd5 -r da7e6655cd4c Nominal/Ex/TypeSchemes.thy --- 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 \ undefined" - --"The following is accepted by 'function' but not by 'nominal_primrec'" -function (default "sum_case (\x. Inl undefined) (\x. Inr undefined)") +nominal_primrec (default "sum_case (\x. Inl undefined) (\x. Inr undefined)") subst :: "(name \ ty) list \ ty \ ty" and substs :: "(name \ ty) list \ tys \ tys" where diff -r 5165f4552cd5 -r da7e6655cd4c Nominal/Nominal2_Base.thy --- 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: "\!x. P x" - shows "(p \ (THE_default d P)) = (THE_default d (p \ P))" + shows "(p \ (THE_default d P)) = (THE_default (p \ d) (p \ 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 == (\x::'a. THE_default d (G x))" + assumes f_def: "f == (\x::'a. THE_default (d x) (G x))" assumes eqvt: "eqvt G" assumes ex1: "\!y. G x y" shows "(p \ (f x)) = f (p \ 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 == (\x::'a. THE_default d (G x))" + assumes f_def: "f == (\x::'a. THE_default (d x) (G x))" assumes eqvt: "eqvt G" assumes ex1: "\!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 == (\x::'a. THE_default d (G x))" + assumes f_def: "f == (\x::'a. THE_default (d x) (G x))" assumes P_all: "\x y. G x y \ P x y" assumes ex1: "\!y. G x y" shows "P x (f x)" diff -r 5165f4552cd5 -r da7e6655cd4c Nominal/nominal_function_core.ML --- 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