src/HOL/Library/FinFun.thy
changeset 48029 9d9c9069abbc
parent 48028 a5377f6d9f14
child 48030 ac43c8a7dcb5
equal deleted inserted replaced
48028:a5377f6d9f14 48029:9d9c9069abbc
    82 subsection {* The finfun type *}
    82 subsection {* The finfun type *}
    83 
    83 
    84 definition "finfun = {f::'a\<Rightarrow>'b. \<exists>b. finite {a. f a \<noteq> b}}"
    84 definition "finfun = {f::'a\<Rightarrow>'b. \<exists>b. finite {a. f a \<noteq> b}}"
    85 
    85 
    86 typedef (open) ('a,'b) finfun  ("(_ \<Rightarrow>\<^isub>f /_)" [22, 21] 21) = "finfun :: ('a => 'b) set"
    86 typedef (open) ('a,'b) finfun  ("(_ \<Rightarrow>\<^isub>f /_)" [22, 21] 21) = "finfun :: ('a => 'b) set"
       
    87   morphisms finfun_apply Abs_finfun
    87 proof -
    88 proof -
    88   have "\<exists>f. finite {x. f x \<noteq> undefined}"
    89   have "\<exists>f. finite {x. f x \<noteq> undefined}"
    89   proof
    90   proof
    90     show "finite {x. (\<lambda>y. undefined) x \<noteq> undefined}" by auto
    91     show "finite {x. (\<lambda>y. undefined) x \<noteq> undefined}" by auto
    91   qed
    92   qed
   192   hence "finite {b. f (a, b) \<noteq> c}" by(rule finite_subset)(rule finite_imageI[OF c])
   193   hence "finite {b. f (a, b) \<noteq> c}" by(rule finite_subset)(rule finite_imageI[OF c])
   193   thus "curry f a \<in> finfun" unfolding finfun_def by auto
   194   thus "curry f a \<in> finfun" unfolding finfun_def by auto
   194 qed
   195 qed
   195 
   196 
   196 lemmas finfun_simp = 
   197 lemmas finfun_simp = 
   197   fst_finfun snd_finfun Abs_finfun_inverse Rep_finfun_inverse Abs_finfun_inject Rep_finfun_inject Diag_finfun finfun_curry
   198   fst_finfun snd_finfun Abs_finfun_inverse finfun_apply_inverse Abs_finfun_inject finfun_apply_inject Diag_finfun finfun_curry
   198 lemmas finfun_iff = const_finfun fun_upd_finfun Rep_finfun map_of_finfun
   199 lemmas finfun_iff = const_finfun fun_upd_finfun finfun_apply map_of_finfun
   199 lemmas finfun_intro = finfun_left_compose fst_finfun snd_finfun
   200 lemmas finfun_intro = finfun_left_compose fst_finfun snd_finfun
   200 
   201 
   201 lemma Abs_finfun_inject_finite:
   202 lemma Abs_finfun_inject_finite:
   202   fixes x y :: "'a \<Rightarrow> 'b"
   203   fixes x y :: "'a \<Rightarrow> 'b"
   203   assumes fin: "finite (UNIV :: 'a set)"
   204   assumes fin: "finite (UNIV :: 'a set)"
   229 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
   230 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
   230 
   231 
   231 lemma Abs_finfun_inverse_finite:
   232 lemma Abs_finfun_inverse_finite:
   232   fixes x :: "'a \<Rightarrow> 'b"
   233   fixes x :: "'a \<Rightarrow> 'b"
   233   assumes fin: "finite (UNIV :: 'a set)"
   234   assumes fin: "finite (UNIV :: 'a set)"
   234   shows "Rep_finfun (Abs_finfun x) = x"
   235   shows "finfun_apply (Abs_finfun x) = x"
   235 proof -
   236 proof -
   236   from fin have "x \<in> finfun"
   237   from fin have "x \<in> finfun"
   237     by(auto simp add: finfun_def intro: finite_subset)
   238     by(auto simp add: finfun_def intro: finite_subset)
   238   thus ?thesis by simp
   239   thus ?thesis by simp
   239 qed
   240 qed
   240 
   241 
   241 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   242 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   242 
   243 
   243 lemma Abs_finfun_inverse_finite_class:
   244 lemma Abs_finfun_inverse_finite_class:
   244   fixes x :: "('a :: finite) \<Rightarrow> 'b"
   245   fixes x :: "('a :: finite) \<Rightarrow> 'b"
   245   shows "Rep_finfun (Abs_finfun x) = x"
   246   shows "finfun_apply (Abs_finfun x) = x"
   246 using finite_UNIV by(simp add: Abs_finfun_inverse_finite)
   247 using finite_UNIV by(simp add: Abs_finfun_inverse_finite)
   247 
   248 
   248 lemma finfun_eq_finite_UNIV: "finite (UNIV :: 'a set) \<Longrightarrow> (finfun :: ('a \<Rightarrow> 'b) set) = UNIV"
   249 lemma finfun_eq_finite_UNIV: "finite (UNIV :: 'a set) \<Longrightarrow> (finfun :: ('a \<Rightarrow> 'b) set) = UNIV"
   249 unfolding finfun_def by(auto intro: finite_subset)
   250 unfolding finfun_def by(auto intro: finite_subset)
   250 
   251 
   323 proof
   324 proof
   324   fix a a' :: 'a
   325   fix a a' :: 'a
   325   show "(\<lambda>f. f(\<^sup>f a := b')) \<circ> (\<lambda>f. f(\<^sup>f a' := b')) = (\<lambda>f. f(\<^sup>f a' := b')) \<circ> (\<lambda>f. f(\<^sup>f a := b'))"
   326   show "(\<lambda>f. f(\<^sup>f a := b')) \<circ> (\<lambda>f. f(\<^sup>f a' := b')) = (\<lambda>f. f(\<^sup>f a' := b')) \<circ> (\<lambda>f. f(\<^sup>f a := b'))"
   326   proof
   327   proof
   327     fix b
   328     fix b
   328     have "(Rep_finfun b)(a := b', a' := b') = (Rep_finfun b)(a' := b', a := b')"
   329     have "(finfun_apply b)(a := b', a' := b') = (finfun_apply b)(a' := b', a := b')"
   329       by(cases "a = a'")(auto simp add: fun_upd_twist)
   330       by(cases "a = a'")(auto simp add: fun_upd_twist)
   330     then have "b(\<^sup>f a := b')(\<^sup>f a' := b') = b(\<^sup>f a' := b')(\<^sup>f a := b')"
   331     then have "b(\<^sup>f a := b')(\<^sup>f a' := b') = b(\<^sup>f a' := b')(\<^sup>f a := b')"
   331       by(auto simp add: finfun_update_def fun_upd_twist)
   332       by(auto simp add: finfun_update_def fun_upd_twist)
   332     then show "((\<lambda>f. f(\<^sup>f a := b')) \<circ> (\<lambda>f. f(\<^sup>f a' := b'))) b = ((\<lambda>f. f(\<^sup>f a' := b')) \<circ> (\<lambda>f. f(\<^sup>f a := b'))) b"
   333     then show "((\<lambda>f. f(\<^sup>f a := b')) \<circ> (\<lambda>f. f(\<^sup>f a' := b'))) b = ((\<lambda>f. f(\<^sup>f a' := b')) \<circ> (\<lambda>f. f(\<^sup>f a := b'))) b"
   333       by (simp add: fun_eq_iff)
   334       by (simp add: fun_eq_iff)
   420 qed
   421 qed
   421 
   422 
   422 lift_definition finfun_default :: "'a \<Rightarrow>\<^isub>f 'b \<Rightarrow> 'b"
   423 lift_definition finfun_default :: "'a \<Rightarrow>\<^isub>f 'b \<Rightarrow> 'b"
   423 is "finfun_default_aux" ..
   424 is "finfun_default_aux" ..
   424 
   425 
   425 lemma finite_finfun_default: "finite {a. Rep_finfun f a \<noteq> finfun_default f}"
   426 lemma finite_finfun_default: "finite {a. finfun_apply f a \<noteq> finfun_default f}"
   426 apply transfer apply (erule finite_finfun_default_aux)
   427 apply transfer apply (erule finite_finfun_default_aux)
   427 unfolding Rel_def fun_rel_def cr_finfun_def by simp
   428 unfolding Rel_def fun_rel_def cr_finfun_def by simp
   428 
   429 
   429 lemma finfun_default_const: "finfun_default ((\<lambda>\<^isup>f b) :: 'a \<Rightarrow>\<^isub>f 'b) = (if finite (UNIV :: 'a set) then undefined else b)"
   430 lemma finfun_default_const: "finfun_default ((\<lambda>\<^isup>f b) :: 'a \<Rightarrow>\<^isub>f 'b) = (if finite (UNIV :: 'a set) then undefined else b)"
   430 apply(transfer)
   431 apply(transfer)
   872 qed
   873 qed
   873 
   874 
   874 
   875 
   875 subsection {* Function application *}
   876 subsection {* Function application *}
   876 
   877 
   877 definition finfun_apply :: "'a \<Rightarrow>\<^isub>f 'b \<Rightarrow> 'a \<Rightarrow> 'b" ("_\<^sub>f" [1000] 1000)
   878 notation finfun_apply ("_\<^sub>f" [1000] 1000)
   878 where [code del]: "finfun_apply = (\<lambda>f a. finfun_rec (\<lambda>b. b) (\<lambda>a' b c. if (a = a') then b else c) f)"
       
   879 
   879 
   880 interpretation finfun_apply_aux: finfun_rec_wf_aux "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   880 interpretation finfun_apply_aux: finfun_rec_wf_aux "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   881 by(unfold_locales) auto
   881 by(unfold_locales) auto
   882 
   882 
   883 interpretation finfun_apply: finfun_rec_wf "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   883 interpretation finfun_apply: finfun_rec_wf "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   890     hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)"
   890     hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)"
   891       by induct auto }
   891       by induct auto }
   892   from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp
   892   from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp
   893 qed
   893 qed
   894 
   894 
   895 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b)\<^sub>f a = b"
   895 lemma finfun_apply_def: "finfun_apply = (\<lambda>f a. finfun_rec (\<lambda>b. b) (\<lambda>a' b c. if (a = a') then b else c) f)"
   896 by(simp add: finfun_apply_def)
   896 proof(rule finfun_rec_unique)
       
   897   fix c show "finfun_apply (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(simp add: finfun_const.rep_eq)
       
   898 next
       
   899   fix g a b show "finfun_apply g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else finfun_apply g c)"
       
   900     by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse finfun_apply)
       
   901 qed auto
   897 
   902 
   898 lemma finfun_upd_apply: "f(\<^sup>fa := b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')"
   903 lemma finfun_upd_apply: "f(\<^sup>fa := b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')"
   899   and finfun_upd_apply_code [code]: "(finfun_update_code f a b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')"
   904   and finfun_upd_apply_code [code]: "(finfun_update_code f a b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')"
   900 by(simp_all add: finfun_apply_def)
   905 by(simp_all add: finfun_apply_def)
   901 
   906 
       
   907 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b)\<^sub>f a = b"
       
   908 by(simp add: finfun_apply_def)
       
   909 
   902 lemma finfun_upd_apply_same [simp]:
   910 lemma finfun_upd_apply_same [simp]:
   903   "f(\<^sup>fa := b)\<^sub>f a = b"
   911   "f(\<^sup>fa := b)\<^sub>f a = b"
   904 by(simp add: finfun_upd_apply)
   912 by(simp add: finfun_upd_apply)
   905 
   913 
   906 lemma finfun_upd_apply_other [simp]:
   914 lemma finfun_upd_apply_other [simp]:
   907   "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b)\<^sub>f a' = f\<^sub>f a'"
   915   "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b)\<^sub>f a' = f\<^sub>f a'"
   908 by(simp add: finfun_upd_apply)
   916 by(simp add: finfun_upd_apply)
   909 
   917 
   910 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
   918 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
   911 
   919 
   912 lemma finfun_apply_Rep_finfun:
       
   913   "finfun_apply = Rep_finfun"
       
   914 proof(rule finfun_rec_unique)
       
   915   fix c show "Rep_finfun (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(auto simp add: finfun_const_def)
       
   916 next
       
   917   fix g a b show "Rep_finfun g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else Rep_finfun g c)"
       
   918     by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse Rep_finfun intro: ext)
       
   919 qed(auto intro: ext)
       
   920 
       
   921 lemma finfun_ext: "(\<And>a. f\<^sub>f a = g\<^sub>f a) \<Longrightarrow> f = g"
   920 lemma finfun_ext: "(\<And>a. f\<^sub>f a = g\<^sub>f a) \<Longrightarrow> f = g"
   922 by(auto simp add: finfun_apply_Rep_finfun Rep_finfun_inject[symmetric] simp del: Rep_finfun_inject intro: ext)
   921 by(auto simp add: finfun_apply_inject[symmetric] simp del: finfun_apply_inject)
   923 
   922 
   924 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   923 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   925 
   924 
   926 lemma expand_finfun_eq: "(f = g) = (f\<^sub>f = g\<^sub>f)"
   925 lemma expand_finfun_eq: "(f = g) = (f\<^sub>f = g\<^sub>f)"
   927 by(auto intro: finfun_ext)
   926 by(auto intro: finfun_ext)
   984     { fix c show "Abs_finfun (g \<circ> (\<lambda>\<^isup>f c)\<^sub>f) = (\<lambda>\<^isup>f g c)"
   983     { fix c show "Abs_finfun (g \<circ> (\<lambda>\<^isup>f c)\<^sub>f) = (\<lambda>\<^isup>f g c)"
   985         by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) }
   984         by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) }
   986     { fix g' a b show "Abs_finfun (g \<circ> g'(\<^sup>f a := b)\<^sub>f) = (Abs_finfun (g \<circ> g'\<^sub>f))(\<^sup>f a := g b)"
   985     { fix g' a b show "Abs_finfun (g \<circ> g'(\<^sup>f a := b)\<^sub>f) = (Abs_finfun (g \<circ> g'\<^sub>f))(\<^sup>f a := g b)"
   987       proof -
   986       proof -
   988         obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g')
   987         obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g')
   989         moreover hence "(g \<circ> g'\<^sub>f) \<in> finfun" by(simp add: finfun_apply_Rep_finfun finfun_left_compose)
   988         moreover hence "(g \<circ> g'\<^sub>f) \<in> finfun" by(simp add: finfun_left_compose)
   990         moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto intro: ext)
   989         moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto intro: ext)
   991         ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def finfun_apply_Rep_finfun)
   990         ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def)
   992       qed }
   991       qed }
   993   qed auto
   992   qed auto
   994   thus ?thesis by(auto simp add: fun_eq_iff)
   993   thus ?thesis by(auto simp add: fun_eq_iff)
   995 qed
   994 qed
   996 
   995 
   997 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   996 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
   998 
   997 
   999 definition finfun_comp2 :: "'b \<Rightarrow>\<^isub>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>\<^isub>f 'c" (infixr "\<^sub>f\<circ>" 55)
   998 definition finfun_comp2 :: "'b \<Rightarrow>\<^isub>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>\<^isub>f 'c" (infixr "\<^sub>f\<circ>" 55)
  1000 where [code del]: "finfun_comp2 g f = Abs_finfun (Rep_finfun g \<circ> f)"
   999 where [code del]: "finfun_comp2 g f = Abs_finfun (finfun_apply g \<circ> f)"
  1001 
  1000 
  1002 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
  1001 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
  1003 
  1002 
  1004 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)"
  1003 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)"
  1005 by(simp add: finfun_comp2_def finfun_const_def comp_def)
  1004 by(simp add: finfun_comp2_def finfun_const_def comp_def)
  1007 lemma finfun_comp2_update:
  1006 lemma finfun_comp2_update:
  1008   assumes inj: "inj f"
  1007   assumes inj: "inj f"
  1009   shows "finfun_comp2 (g(\<^sup>f b := c)) f = (if b \<in> range f then (finfun_comp2 g f)(\<^sup>f inv f b := c) else finfun_comp2 g f)"
  1008   shows "finfun_comp2 (g(\<^sup>f b := c)) f = (if b \<in> range f then (finfun_comp2 g f)(\<^sup>f inv f b := c) else finfun_comp2 g f)"
  1010 proof(cases "b \<in> range f")
  1009 proof(cases "b \<in> range f")
  1011   case True
  1010   case True
  1012   from inj have "\<And>x. (Rep_finfun g)(f x := c) \<circ> f = (Rep_finfun g \<circ> f)(x := c)" by(auto intro!: ext dest: injD)
  1011   from inj have "\<And>x. (finfun_apply g)(f x := c) \<circ> f = (finfun_apply g \<circ> f)(x := c)" by(auto intro!: ext dest: injD)
  1013   with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose)
  1012   with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose)
  1014 next
  1013 next
  1015   case False
  1014   case False
  1016   hence "(Rep_finfun g)(b := c) \<circ> f = Rep_finfun g \<circ> f" by(auto simp add: fun_eq_iff)
  1015   hence "(finfun_apply g)(b := c) \<circ> f = finfun_apply g \<circ> f" by(auto simp add: fun_eq_iff)
  1017   with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def)
  1016   with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def)
  1018 qed
  1017 qed
  1019 
  1018 
  1020 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
  1019 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
  1021 
       
  1022 
  1020 
  1023 
  1021 
  1024 subsection {* Universal quantification *}
  1022 subsection {* Universal quantification *}
  1025 
  1023 
  1026 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>\<^isub>f bool \<Rightarrow> bool"
  1024 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>\<^isub>f bool \<Rightarrow> bool"
  1129 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply intro: ext)
  1127 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply intro: ext)
  1130 
  1128 
  1131 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
  1129 declare finfun_simp [simp] finfun_iff [iff] finfun_intro [intro]
  1132 
  1130 
  1133 lemma finfun_Diag_conv_Abs_finfun:
  1131 lemma finfun_Diag_conv_Abs_finfun:
  1134   "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (Rep_finfun f x, Rep_finfun g x)))"
  1132   "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x)))"
  1135 proof -
  1133 proof -
  1136   have "(\<lambda>f :: 'a \<Rightarrow>\<^isub>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (Rep_finfun f x, Rep_finfun g x))))"
  1134   have "(\<lambda>f :: 'a \<Rightarrow>\<^isub>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x))))"
  1137   proof(rule finfun_rec_unique)
  1135   proof(rule finfun_rec_unique)
  1138     { fix c show "Abs_finfun (\<lambda>x. (Rep_finfun (\<lambda>\<^isup>f c) x, Rep_finfun g x)) = Pair c \<circ>\<^isub>f g"
  1136     { fix c show "Abs_finfun (\<lambda>x. (finfun_apply (\<lambda>\<^isup>f c) x, finfun_apply g x)) = Pair c \<circ>\<^isub>f g"
  1139         by(simp add: finfun_comp_conv_comp finfun_apply_Rep_finfun o_def finfun_const_def) }
  1137         by(simp add: finfun_comp_conv_comp o_def finfun_const_def) }
  1140     { fix g' a b
  1138     { fix g' a b
  1141       show "Abs_finfun (\<lambda>x. (Rep_finfun g'(\<^sup>f a := b) x, Rep_finfun g x)) =
  1139       show "Abs_finfun (\<lambda>x. (finfun_apply g'(\<^sup>f a := b) x, finfun_apply g x)) =
  1142             (Abs_finfun (\<lambda>x. (Rep_finfun g' x, Rep_finfun g x)))(\<^sup>f a := (b, g\<^sub>f a))"
  1140             (Abs_finfun (\<lambda>x. (finfun_apply g' x, finfun_apply g x)))(\<^sup>f a := (b, g\<^sub>f a))"
  1143         by(auto simp add: finfun_update_def fun_eq_iff finfun_apply_Rep_finfun simp del: fun_upd_apply) simp }
  1141         by(auto simp add: finfun_update_def fun_eq_iff simp del: fun_upd_apply) simp }
  1144   qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1)
  1142   qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1)
  1145   thus ?thesis by(auto simp add: fun_eq_iff)
  1143   thus ?thesis by(auto simp add: fun_eq_iff)
  1146 qed
  1144 qed
  1147 
  1145 
  1148 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
  1146 declare finfun_simp [simp del] finfun_iff [iff del] finfun_intro [rule del]
  1164 by(simp add: finfun_fst_def)
  1162 by(simp add: finfun_fst_def)
  1165 
  1163 
  1166 lemma finfun_fst_conv [simp]: "finfun_fst (f, g)\<^sup>f = f"
  1164 lemma finfun_fst_conv [simp]: "finfun_fst (f, g)\<^sup>f = f"
  1167 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_Diag_const1 finfun_fst_comp_conv o_def finfun_Diag_update1 finfun_fst_update)
  1165 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_Diag_const1 finfun_fst_comp_conv o_def finfun_Diag_update1 finfun_fst_update)
  1168 
  1166 
  1169 lemma finfun_fst_conv_Abs_finfun: "finfun_fst = (\<lambda>f. Abs_finfun (fst o Rep_finfun f))"
  1167 lemma finfun_fst_conv_Abs_finfun: "finfun_fst = (\<lambda>f. Abs_finfun (fst o finfun_apply f))"
  1170 by(simp add: finfun_fst_def [abs_def] finfun_comp_conv_comp finfun_apply_Rep_finfun)
  1168 by(simp add: finfun_fst_def [abs_def] finfun_comp_conv_comp)
  1171 
  1169 
  1172 
  1170 
  1173 definition finfun_snd :: "'a \<Rightarrow>\<^isub>f ('b \<times> 'c) \<Rightarrow> 'a \<Rightarrow>\<^isub>f 'c"
  1171 definition finfun_snd :: "'a \<Rightarrow>\<^isub>f ('b \<times> 'c) \<Rightarrow> 'a \<Rightarrow>\<^isub>f 'c"
  1174 where [code]: "finfun_snd f = snd \<circ>\<^isub>f f"
  1172 where [code]: "finfun_snd f = snd \<circ>\<^isub>f f"
  1175 
  1173 
  1186 lemma finfun_snd_conv [simp]: "finfun_snd (f, g)\<^sup>f = g"
  1184 lemma finfun_snd_conv [simp]: "finfun_snd (f, g)\<^sup>f = g"
  1187 apply(induct f rule: finfun_weak_induct)
  1185 apply(induct f rule: finfun_weak_induct)
  1188 apply(auto simp add: finfun_Diag_const1 finfun_snd_comp_conv o_def finfun_Diag_update1 finfun_snd_update finfun_upd_apply intro: finfun_ext)
  1186 apply(auto simp add: finfun_Diag_const1 finfun_snd_comp_conv o_def finfun_Diag_update1 finfun_snd_update finfun_upd_apply intro: finfun_ext)
  1189 done
  1187 done
  1190 
  1188 
  1191 lemma finfun_snd_conv_Abs_finfun: "finfun_snd = (\<lambda>f. Abs_finfun (snd o Rep_finfun f))"
  1189 lemma finfun_snd_conv_Abs_finfun: "finfun_snd = (\<lambda>f. Abs_finfun (snd o finfun_apply f))"
  1192 by(simp add: finfun_snd_def [abs_def] finfun_comp_conv_comp finfun_apply_Rep_finfun)
  1190 by(simp add: finfun_snd_def [abs_def] finfun_comp_conv_comp)
  1193 
  1191 
  1194 lemma finfun_Diag_collapse [simp]: "(finfun_fst f, finfun_snd f)\<^sup>f = f"
  1192 lemma finfun_Diag_collapse [simp]: "(finfun_fst f, finfun_snd f)\<^sup>f = f"
  1195 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_fst_const finfun_snd_const finfun_fst_update finfun_snd_update finfun_Diag_update_update)
  1193 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_fst_const finfun_snd_const finfun_fst_update finfun_snd_update finfun_Diag_update_update)
  1196 
  1194 
  1197 subsection {* Currying for FinFuns *}
  1195 subsection {* Currying for FinFuns *}
  1217   { fix A :: "('c \<times> 'a) set"
  1215   { fix A :: "('c \<times> 'a) set"
  1218     interpret comp_fun_commute "\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b'"
  1216     interpret comp_fun_commute "\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b'"
  1219       by(rule finfun_curry_aux.upd_left_comm)
  1217       by(rule finfun_curry_aux.upd_left_comm)
  1220     from fin have "finite A" by(auto intro: finite_subset)
  1218     from fin have "finite A" by(auto intro: finite_subset)
  1221     hence "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) A = Abs_finfun (\<lambda>a. Abs_finfun (\<lambda>b''. if (a, b'') \<in> A then b' else b))"
  1219     hence "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) A = Abs_finfun (\<lambda>a. Abs_finfun (\<lambda>b''. if (a, b'') \<in> A then b' else b))"
  1222       by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def finfun_apply_Rep_finfun intro!: arg_cong[where f="Abs_finfun"] ext) }
  1220       by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def intro!: arg_cong[where f="Abs_finfun"] ext) }
  1223   from this[of UNIV]
  1221   from this[of UNIV]
  1224   show "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) UNIV = (finfun_const \<circ> finfun_const) b'"
  1222   show "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) UNIV = (finfun_const \<circ> finfun_const) b'"
  1225     by(simp add: finfun_const_def)
  1223     by(simp add: finfun_const_def)
  1226 qed
  1224 qed
  1227 
  1225 
  1250   thus ?thesis unfolding finfun_def by auto
  1248   thus ?thesis unfolding finfun_def by auto
  1251 qed
  1249 qed
  1252 
  1250 
  1253 lemma finfun_curry_conv_curry:
  1251 lemma finfun_curry_conv_curry:
  1254   fixes f :: "('a \<times> 'b) \<Rightarrow>\<^isub>f 'c"
  1252   fixes f :: "('a \<times> 'b) \<Rightarrow>\<^isub>f 'c"
  1255   shows "finfun_curry f = Abs_finfun (\<lambda>a. Abs_finfun (curry (Rep_finfun f) a))"
  1253   shows "finfun_curry f = Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a))"
  1256 proof -
  1254 proof -
  1257   have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>\<^isub>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (Rep_finfun f) a)))"
  1255   have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>\<^isub>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a)))"
  1258   proof(rule finfun_rec_unique)
  1256   proof(rule finfun_rec_unique)
  1259     { fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp }
  1257     { fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp }
  1260     { fix f a c show "finfun_curry (f(\<^sup>f a := c)) = (finfun_curry f)(\<^sup>f fst a := ((finfun_curry f)\<^sub>f (fst a))(\<^sup>f snd a := c))"
  1258     { fix f a c show "finfun_curry (f(\<^sup>f a := c)) = (finfun_curry f)(\<^sup>f fst a := ((finfun_curry f)\<^sub>f (fst a))(\<^sup>f snd a := c))"
  1261         by(cases a) simp }
  1259         by(cases a) simp }
  1262     { fix c show "Abs_finfun (\<lambda>a. Abs_finfun (curry (Rep_finfun (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1260     { fix c show "Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1263         by(simp add: finfun_curry_def finfun_const_def curry_def) }
  1261         by(simp add: finfun_curry_def finfun_const_def curry_def) }
  1264     { fix g a b
  1262     { fix g a b
  1265       show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (Rep_finfun g(\<^sup>f a := b)) aa)) =
  1263       show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (finfun_apply g(\<^sup>f a := b)) aa)) =
  1266        (Abs_finfun (\<lambda>a. Abs_finfun (curry (Rep_finfun g) a)))(\<^sup>f
  1264        (Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))(\<^sup>f
  1267        fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (Rep_finfun g) a)))\<^sub>f (fst a))(\<^sup>f snd a := b))"
  1265        fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))\<^sub>f (fst a))(\<^sup>f snd a := b))"
  1268         by(cases a)(auto intro!: ext arg_cong[where f=Abs_finfun] simp add: finfun_curry_def finfun_update_def finfun_apply_Rep_finfun finfun_curry finfun_Abs_finfun_curry) }
  1266         by(cases a)(auto intro!: ext arg_cong[where f=Abs_finfun] simp add: finfun_curry_def finfun_update_def finfun_curry finfun_Abs_finfun_curry) }
  1269   qed
  1267   qed
  1270   thus ?thesis by(auto simp add: fun_eq_iff)
  1268   thus ?thesis by(auto simp add: fun_eq_iff)
  1271 qed
  1269 qed
  1272 
  1270 
  1273 subsection {* Executable equality for FinFuns *}
  1271 subsection {* Executable equality for FinFuns *}
  1316 unfolding card_UNIV_eq_0_infinite_UNIV
  1314 unfolding card_UNIV_eq_0_infinite_UNIV
  1317 by(simp add: finfun_dom_const)
  1315 by(simp add: finfun_dom_const)
  1318 
  1316 
  1319 lemma finfun_dom_finfunI: "(\<lambda>a. f\<^sub>f a \<noteq> finfun_default f) \<in> finfun"
  1317 lemma finfun_dom_finfunI: "(\<lambda>a. f\<^sub>f a \<noteq> finfun_default f) \<in> finfun"
  1320 using finite_finfun_default[of f]
  1318 using finite_finfun_default[of f]
  1321 by(simp add: finfun_def finfun_apply_Rep_finfun exI[where x=False])
  1319 by(simp add: finfun_def exI[where x=False])
  1322 
  1320 
  1323 lemma finfun_dom_update [simp]:
  1321 lemma finfun_dom_update [simp]:
  1324   "finfun_dom (f(\<^sup>f a := b)) = (finfun_dom f)(\<^sup>f a := (b \<noteq> finfun_default f))"
  1322   "finfun_dom (f(\<^sup>f a := b)) = (finfun_dom f)(\<^sup>f a := (b \<noteq> finfun_default f))"
  1325 unfolding finfun_dom_def finfun_update_def
  1323 unfolding finfun_dom_def finfun_update_def
  1326 apply(simp add: finfun_default_update_const finfun_upd_apply finfun_dom_finfunI)
  1324 apply(simp add: finfun_default_update_const fun_upd_apply finfun_dom_finfunI)
  1327 apply(fold finfun_update.rep_eq)
  1325 apply(fold finfun_update.rep_eq)
  1328 apply(simp add: finfun_upd_apply fun_eq_iff finfun_default_update_const)
  1326 apply(simp add: finfun_upd_apply fun_eq_iff fun_upd_def finfun_default_update_const)
  1329 done
  1327 done
  1330 
  1328 
  1331 lemma finfun_dom_update_code [code]:
  1329 lemma finfun_dom_update_code [code]:
  1332   "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)"
  1330   "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)"
  1333 by(simp)
  1331 by(simp)