src/HOL/Library/FinFun.thy
changeset 48035 2f9584581cf2
parent 48034 1c5171abe5cc
child 48036 1edcd5f73505
equal deleted inserted replaced
48034:1c5171abe5cc 48035:2f9584581cf2
   856 qed
   856 qed
   857 
   857 
   858 
   858 
   859 subsection {* Function application *}
   859 subsection {* Function application *}
   860 
   860 
   861 notation finfun_apply ("_\<^sub>f" [1000] 1000)
   861 notation finfun_apply (infixl "$" 999)
   862 
   862 
   863 interpretation finfun_apply_aux: finfun_rec_wf_aux "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   863 interpretation finfun_apply_aux: finfun_rec_wf_aux "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   864 by(unfold_locales) auto
   864 by(unfold_locales) auto
   865 
   865 
   866 interpretation finfun_apply: finfun_rec_wf "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   866 interpretation finfun_apply: finfun_rec_wf "\<lambda>b. b" "\<lambda>a' b c. if (a = a') then b else c"
   873     hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)"
   873     hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)"
   874       by induct auto }
   874       by induct auto }
   875   from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp
   875   from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp
   876 qed
   876 qed
   877 
   877 
   878 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)"
   878 lemma finfun_apply_def: "op $ = (\<lambda>f a. finfun_rec (\<lambda>b. b) (\<lambda>a' b c. if (a = a') then b else c) f)"
   879 proof(rule finfun_rec_unique)
   879 proof(rule finfun_rec_unique)
   880   fix c show "finfun_apply (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(simp add: finfun_const.rep_eq)
   880   fix c show "op $ (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(simp add: finfun_const.rep_eq)
   881 next
   881 next
   882   fix g a b show "finfun_apply g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else finfun_apply g c)"
   882   fix g a b show "op $ g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else g $ c)"
   883     by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse finfun_apply)
   883     by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse finfun_apply)
   884 qed auto
   884 qed auto
   885 
   885 
   886 lemma finfun_upd_apply: "f(\<^sup>fa := b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')"
   886 lemma finfun_upd_apply: "f(\<^sup>fa := b) $ a' = (if a = a' then b else f $ a')"
   887   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')"
   887   and finfun_upd_apply_code [code]: "(finfun_update_code f a b) $ a' = (if a = a' then b else f $ a')"
   888 by(simp_all add: finfun_apply_def)
   888 by(simp_all add: finfun_apply_def)
   889 
   889 
   890 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b)\<^sub>f a = b"
   890 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b) $ a = b"
   891 by(simp add: finfun_apply_def)
   891 by(simp add: finfun_apply_def)
   892 
   892 
   893 lemma finfun_upd_apply_same [simp]:
   893 lemma finfun_upd_apply_same [simp]:
   894   "f(\<^sup>fa := b)\<^sub>f a = b"
   894   "f(\<^sup>fa := b) $ a = b"
   895 by(simp add: finfun_upd_apply)
   895 by(simp add: finfun_upd_apply)
   896 
   896 
   897 lemma finfun_upd_apply_other [simp]:
   897 lemma finfun_upd_apply_other [simp]:
   898   "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b)\<^sub>f a' = f\<^sub>f a'"
   898   "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b) $ a' = f $ a'"
   899 by(simp add: finfun_upd_apply)
   899 by(simp add: finfun_upd_apply)
   900 
   900 
   901 lemma finfun_ext: "(\<And>a. f\<^sub>f a = g\<^sub>f a) \<Longrightarrow> f = g"
   901 lemma finfun_ext: "(\<And>a. f $ a = g $ a) \<Longrightarrow> f = g"
   902 by(auto simp add: finfun_apply_inject[symmetric] simp del: finfun_apply_inject)
   902 by(auto simp add: finfun_apply_inject[symmetric] simp del: finfun_apply_inject)
   903 
   903 
   904 lemma expand_finfun_eq: "(f = g) = (f\<^sub>f = g\<^sub>f)"
   904 lemma expand_finfun_eq: "(f = g) = (op $ f = op $ g)"
   905 by(auto intro: finfun_ext)
   905 by(auto intro: finfun_ext)
   906 
   906 
   907 lemma finfun_const_inject [simp]: "(\<lambda>\<^isup>f b) = (\<lambda>\<^isup>f b') \<equiv> b = b'"
   907 lemma finfun_const_inject [simp]: "(\<lambda>\<^isup>f b) = (\<lambda>\<^isup>f b') \<equiv> b = b'"
   908 by(simp add: expand_finfun_eq fun_eq_iff)
   908 by(simp add: expand_finfun_eq fun_eq_iff)
   909 
   909 
   910 lemma finfun_const_eq_update:
   910 lemma finfun_const_eq_update:
   911   "((\<lambda>\<^isup>f b) = f(\<^sup>f a := b')) = (b = b' \<and> (\<forall>a'. a \<noteq> a' \<longrightarrow> f\<^sub>f a' = b))"
   911   "((\<lambda>\<^isup>f b) = f(\<^sup>f a := b')) = (b = b' \<and> (\<forall>a'. a \<noteq> a' \<longrightarrow> f $ a' = b))"
   912 by(auto simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
   912 by(auto simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
   913 
   913 
   914 subsection {* Function composition *}
   914 subsection {* Function composition *}
   915 
   915 
   916 definition finfun_comp :: "('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow>f 'a \<Rightarrow> 'c \<Rightarrow>f 'b" (infixr "\<circ>\<^isub>f" 55)
   916 definition finfun_comp :: "('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow>f 'a \<Rightarrow> 'c \<Rightarrow>f 'b" (infixr "\<circ>\<^isub>f" 55)
   939 lemma finfun_comp_update [simp]: "g \<circ>\<^isub>f (f(\<^sup>f a := b)) = (g \<circ>\<^isub>f f)(\<^sup>f a := g b)"
   939 lemma finfun_comp_update [simp]: "g \<circ>\<^isub>f (f(\<^sup>f a := b)) = (g \<circ>\<^isub>f f)(\<^sup>f a := g b)"
   940   and finfun_comp_update_code [code]: "g \<circ>\<^isub>f (finfun_update_code f a b) = finfun_update_code (g \<circ>\<^isub>f f) a (g b)"
   940   and finfun_comp_update_code [code]: "g \<circ>\<^isub>f (finfun_update_code f a b) = finfun_update_code (g \<circ>\<^isub>f f) a (g b)"
   941 by(simp_all add: finfun_comp_def)
   941 by(simp_all add: finfun_comp_def)
   942 
   942 
   943 lemma finfun_comp_apply [simp]:
   943 lemma finfun_comp_apply [simp]:
   944   "(g \<circ>\<^isub>f f)\<^sub>f = g \<circ> f\<^sub>f"
   944   "op $ (g \<circ>\<^isub>f f) = g \<circ> op $ f"
   945 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_upd_apply intro: ext)
   945 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_upd_apply)
   946 
   946 
   947 lemma finfun_comp_comp_collapse [simp]: "f \<circ>\<^isub>f g \<circ>\<^isub>f h = (f o g) \<circ>\<^isub>f h"
   947 lemma finfun_comp_comp_collapse [simp]: "f \<circ>\<^isub>f g \<circ>\<^isub>f h = (f o g) \<circ>\<^isub>f h"
   948 by(induct h rule: finfun_weak_induct) simp_all
   948 by(induct h rule: finfun_weak_induct) simp_all
   949 
   949 
   950 lemma finfun_comp_const1 [simp]: "(\<lambda>x. c) \<circ>\<^isub>f f = (\<lambda>\<^isup>f c)"
   950 lemma finfun_comp_const1 [simp]: "(\<lambda>x. c) \<circ>\<^isub>f f = (\<lambda>\<^isup>f c)"
   956 lemma finfun_comp_conv_comp: "g \<circ>\<^isub>f f = Abs_finfun (g \<circ> finfun_apply f)"
   956 lemma finfun_comp_conv_comp: "g \<circ>\<^isub>f f = Abs_finfun (g \<circ> finfun_apply f)"
   957   including finfun
   957   including finfun
   958 proof -
   958 proof -
   959   have "(\<lambda>f. g \<circ>\<^isub>f f) = (\<lambda>f. Abs_finfun (g \<circ> finfun_apply f))"
   959   have "(\<lambda>f. g \<circ>\<^isub>f f) = (\<lambda>f. Abs_finfun (g \<circ> finfun_apply f))"
   960   proof(rule finfun_rec_unique)
   960   proof(rule finfun_rec_unique)
   961     { fix c show "Abs_finfun (g \<circ> (\<lambda>\<^isup>f c)\<^sub>f) = (\<lambda>\<^isup>f g c)"
   961     { fix c show "Abs_finfun (g \<circ> op $ (\<lambda>\<^isup>f c)) = (\<lambda>\<^isup>f g c)"
   962         by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) }
   962         by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) }
   963     { 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)"
   963     { fix g' a b show "Abs_finfun (g \<circ> op $ g'(\<^sup>f a := b)) = (Abs_finfun (g \<circ> op $ g'))(\<^sup>f a := g b)"
   964       proof -
   964       proof -
   965         obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g')
   965         obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g')
   966         moreover hence "(g \<circ> g'\<^sub>f) \<in> finfun" by(simp add: finfun_left_compose)
   966         moreover hence "(g \<circ> op $ g') \<in> finfun" by(simp add: finfun_left_compose)
   967         moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto intro: ext)
   967         moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto)
   968         ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def)
   968         ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def)
   969       qed }
   969       qed }
   970   qed auto
   970   qed auto
   971   thus ?thesis by(auto simp add: fun_eq_iff)
   971   thus ?thesis by(auto simp add: fun_eq_iff)
   972 qed
   972 qed
   973 
   973 
   974 definition finfun_comp2 :: "'b \<Rightarrow>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>f 'c" (infixr "\<^sub>f\<circ>" 55)
   974 definition finfun_comp2 :: "'b \<Rightarrow>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>f 'c" (infixr "\<^sub>f\<circ>" 55)
   975 where [code del]: "finfun_comp2 g f = Abs_finfun (finfun_apply g \<circ> f)"
   975 where [code del]: "finfun_comp2 g f = Abs_finfun (op $ g \<circ> f)"
   976 
   976 
   977 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)"
   977 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)"
   978   including finfun
   978   including finfun
   979 by(simp add: finfun_comp2_def finfun_const_def comp_def)
   979 by(simp add: finfun_comp2_def finfun_const_def comp_def)
   980 
   980 
   982   includes finfun
   982   includes finfun
   983   assumes inj: "inj f"
   983   assumes inj: "inj f"
   984   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)"
   984   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)"
   985 proof(cases "b \<in> range f")
   985 proof(cases "b \<in> range f")
   986   case True
   986   case True
   987   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)
   987   from inj have "\<And>x. (op $ g)(f x := c) \<circ> f = (op $ g \<circ> f)(x := c)" by(auto intro!: ext dest: injD)
   988   with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose)
   988   with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose)
   989 next
   989 next
   990   case False
   990   case False
   991   hence "(finfun_apply g)(b := c) \<circ> f = finfun_apply g \<circ> f" by(auto simp add: fun_eq_iff)
   991   hence "(op $ g)(b := c) \<circ> f = op $ g \<circ> f" by(auto simp add: fun_eq_iff)
   992   with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def)
   992   with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def)
   993 qed
   993 qed
   994 
   994 
   995 subsection {* Universal quantification *}
   995 subsection {* Universal quantification *}
   996 
   996 
   997 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>f bool \<Rightarrow> bool"
   997 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>f bool \<Rightarrow> bool"
   998 where [code del]: "finfun_All_except A P \<equiv> \<forall>a. a \<in> set A \<or> P\<^sub>f a"
   998 where [code del]: "finfun_All_except A P \<equiv> \<forall>a. a \<in> set A \<or> P $ a"
   999 
   999 
  1000 lemma finfun_All_except_const: "finfun_All_except A (\<lambda>\<^isup>f b) \<longleftrightarrow> b \<or> set A = UNIV"
  1000 lemma finfun_All_except_const: "finfun_All_except A (\<lambda>\<^isup>f b) \<longleftrightarrow> b \<or> set A = UNIV"
  1001 by(auto simp add: finfun_All_except_def)
  1001 by(auto simp add: finfun_All_except_def)
  1002 
  1002 
  1003 lemma finfun_All_except_const_finfun_UNIV_code [code]:
  1003 lemma finfun_All_except_const_finfun_UNIV_code [code]:
  1004   "finfun_All_except A (\<lambda>\<^isup>f b) = (b \<or> is_list_UNIV A)"
  1004   "finfun_All_except A (\<lambda>\<^isup>f b) = (b \<or> is_list_UNIV A)"
  1005 by(simp add: finfun_All_except_const is_list_UNIV_iff)
  1005 by(simp add: finfun_All_except_const is_list_UNIV_iff)
  1006 
  1006 
  1007 lemma finfun_All_except_update: 
  1007 lemma finfun_All_except_update:
  1008   "finfun_All_except A f(\<^sup>f a := b) = ((a \<in> set A \<or> b) \<and> finfun_All_except (a # A) f)"
  1008   "finfun_All_except A f(\<^sup>f a := b) = ((a \<in> set A \<or> b) \<and> finfun_All_except (a # A) f)"
  1009 by(fastforce simp add: finfun_All_except_def finfun_upd_apply)
  1009 by(fastforce simp add: finfun_All_except_def finfun_upd_apply)
  1010 
  1010 
  1011 lemma finfun_All_except_update_code [code]:
  1011 lemma finfun_All_except_update_code [code]:
  1012   fixes a :: "'a :: card_UNIV"
  1012   fixes a :: "'a :: card_UNIV"
  1020 by(simp add: finfun_All_def finfun_All_except_def)
  1020 by(simp add: finfun_All_def finfun_All_except_def)
  1021 
  1021 
  1022 lemma finfun_All_update: "finfun_All f(\<^sup>f a := b) = (b \<and> finfun_All_except [a] f)"
  1022 lemma finfun_All_update: "finfun_All f(\<^sup>f a := b) = (b \<and> finfun_All_except [a] f)"
  1023 by(simp add: finfun_All_def finfun_All_except_update)
  1023 by(simp add: finfun_All_def finfun_All_except_update)
  1024 
  1024 
  1025 lemma finfun_All_All: "finfun_All P = All P\<^sub>f"
  1025 lemma finfun_All_All: "finfun_All P = All (op $ P)"
  1026 by(simp add: finfun_All_def finfun_All_except_def)
  1026 by(simp add: finfun_All_def finfun_All_except_def)
  1027 
  1027 
  1028 
  1028 
  1029 definition finfun_Ex :: "'a \<Rightarrow>f bool \<Rightarrow> bool"
  1029 definition finfun_Ex :: "'a \<Rightarrow>f bool \<Rightarrow> bool"
  1030 where "finfun_Ex P = Not (finfun_All (Not \<circ>\<^isub>f P))"
  1030 where "finfun_Ex P = Not (finfun_All (Not \<circ>\<^isub>f P))"
  1031 
  1031 
  1032 lemma finfun_Ex_Ex: "finfun_Ex P = Ex P\<^sub>f"
  1032 lemma finfun_Ex_Ex: "finfun_Ex P = Ex (op $ P)"
  1033 unfolding finfun_Ex_def finfun_All_All by simp
  1033 unfolding finfun_Ex_def finfun_All_All by simp
  1034 
  1034 
  1035 lemma finfun_Ex_const [simp]: "finfun_Ex (\<lambda>\<^isup>f b) = b"
  1035 lemma finfun_Ex_const [simp]: "finfun_Ex (\<lambda>\<^isup>f b) = b"
  1036 by(simp add: finfun_Ex_def)
  1036 by(simp add: finfun_Ex_def)
  1037 
  1037 
  1038 
  1038 
  1039 subsection {* A diagonal operator for FinFuns *}
  1039 subsection {* A diagonal operator for FinFuns *}
  1040 
  1040 
  1041 definition finfun_Diag :: "'a \<Rightarrow>f 'b \<Rightarrow> 'a \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f ('b \<times> 'c)" ("(1'(_,/ _')\<^sup>f)" [0, 0] 1000)
  1041 definition finfun_Diag :: "'a \<Rightarrow>f 'b \<Rightarrow> 'a \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f ('b \<times> 'c)" ("(1'(_,/ _')\<^sup>f)" [0, 0] 1000)
  1042 where [code del]: "finfun_Diag f g = finfun_rec (\<lambda>b. Pair b \<circ>\<^isub>f g) (\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))) f"
  1042 where [code del]: "finfun_Diag f g = finfun_rec (\<lambda>b. Pair b \<circ>\<^isub>f g) (\<lambda>a b c. c(\<^sup>f a := (b, g $ a))) f"
  1043 
  1043 
  1044 interpretation finfun_Diag_aux: finfun_rec_wf_aux "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))"
  1044 interpretation finfun_Diag_aux: finfun_rec_wf_aux "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g $ a))"
  1045 by(unfold_locales)(simp_all add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1045 by(unfold_locales)(simp_all add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1046 
  1046 
  1047 interpretation finfun_Diag: finfun_rec_wf "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))"
  1047 interpretation finfun_Diag: finfun_rec_wf "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g $ a))"
  1048 proof
  1048 proof
  1049   fix b' b :: 'a
  1049   fix b' b :: 'a
  1050   assume fin: "finite (UNIV :: 'c set)"
  1050   assume fin: "finite (UNIV :: 'c set)"
  1051   { fix A :: "'c set"
  1051   { fix A :: "'c set"
  1052     interpret comp_fun_commute "\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))" by(rule finfun_Diag_aux.upd_left_comm)
  1052     interpret comp_fun_commute "\<lambda>a c. c(\<^sup>f a := (b', g $ a))" by(rule finfun_Diag_aux.upd_left_comm)
  1053     from fin have "finite A" by(auto intro: finite_subset)
  1053     from fin have "finite A" by(auto intro: finite_subset)
  1054     hence "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))) (Pair b \<circ>\<^isub>f g) A =
  1054     hence "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g $ a))) (Pair b \<circ>\<^isub>f g) A =
  1055       Abs_finfun (\<lambda>a. (if a \<in> A then b' else b, g\<^sub>f a))"
  1055       Abs_finfun (\<lambda>a. (if a \<in> A then b' else b, g $ a))"
  1056       by(induct)(simp_all add: finfun_const_def finfun_comp_conv_comp o_def,
  1056       by(induct)(simp_all add: finfun_const_def finfun_comp_conv_comp o_def,
  1057                  auto simp add: finfun_update_def Abs_finfun_inverse_finite fun_upd_def Abs_finfun_inject_finite fun_eq_iff fin) }
  1057                  auto simp add: finfun_update_def Abs_finfun_inverse_finite fun_upd_def Abs_finfun_inject_finite fun_eq_iff fin) }
  1058   from this[of UNIV] show "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))) (Pair b \<circ>\<^isub>f g) UNIV = Pair b' \<circ>\<^isub>f g"
  1058   from this[of UNIV] show "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g $ a))) (Pair b \<circ>\<^isub>f g) UNIV = Pair b' \<circ>\<^isub>f g"
  1059     by(simp add: finfun_const_def finfun_comp_conv_comp o_def)
  1059     by(simp add: finfun_const_def finfun_comp_conv_comp o_def)
  1060 qed
  1060 qed
  1061 
  1061 
  1062 lemma finfun_Diag_const1: "(\<lambda>\<^isup>f b, g)\<^sup>f = Pair b \<circ>\<^isub>f g"
  1062 lemma finfun_Diag_const1: "(\<lambda>\<^isup>f b, g)\<^sup>f = Pair b \<circ>\<^isub>f g"
  1063 by(simp add: finfun_Diag_def)
  1063 by(simp add: finfun_Diag_def)
  1069 lemma finfun_Diag_const_code [code]:
  1069 lemma finfun_Diag_const_code [code]:
  1070   "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))"
  1070   "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))"
  1071   "(\<lambda>\<^isup>f b, g(\<^sup>fc a := c))\<^sup>f = (\<lambda>\<^isup>f b, g)\<^sup>f(\<^sup>fc a := (b, c))"
  1071   "(\<lambda>\<^isup>f b, g(\<^sup>fc a := c))\<^sup>f = (\<lambda>\<^isup>f b, g)\<^sup>f(\<^sup>fc a := (b, c))"
  1072 by(simp_all add: finfun_Diag_const1)
  1072 by(simp_all add: finfun_Diag_const1)
  1073 
  1073 
  1074 lemma finfun_Diag_update1: "(f(\<^sup>f a := b), g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))"
  1074 lemma finfun_Diag_update1: "(f(\<^sup>f a := b), g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))"
  1075   and finfun_Diag_update1_code [code]: "(finfun_update_code f a b, g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))"
  1075   and finfun_Diag_update1_code [code]: "(finfun_update_code f a b, g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))"
  1076 by(simp_all add: finfun_Diag_def)
  1076 by(simp_all add: finfun_Diag_def)
  1077 
  1077 
  1078 lemma finfun_Diag_const2: "(f, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>b. (b, c)) \<circ>\<^isub>f f"
  1078 lemma finfun_Diag_const2: "(f, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>b. (b, c)) \<circ>\<^isub>f f"
  1079 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1)
  1079 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1)
  1080 
  1080 
  1081 lemma finfun_Diag_update2: "(f, g(\<^sup>f a := c))\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (f\<^sub>f a, c))"
  1081 lemma finfun_Diag_update2: "(f, g(\<^sup>f a := c))\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (f $ a, c))"
  1082 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1)
  1082 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1)
  1083 
  1083 
  1084 lemma finfun_Diag_const_const [simp]: "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))"
  1084 lemma finfun_Diag_const_const [simp]: "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))"
  1085 by(simp add: finfun_Diag_const1)
  1085 by(simp add: finfun_Diag_const1)
  1086 
  1086 
  1091 lemma finfun_Diag_update_const:
  1091 lemma finfun_Diag_update_const:
  1092   "(f(\<^sup>f a := b), \<lambda>\<^isup>f c)\<^sup>f = (f, \<lambda>\<^isup>f c)\<^sup>f(\<^sup>f a := (b, c))"
  1092   "(f(\<^sup>f a := b), \<lambda>\<^isup>f c)\<^sup>f = (f, \<lambda>\<^isup>f c)\<^sup>f(\<^sup>f a := (b, c))"
  1093 by(simp add: finfun_Diag_def)
  1093 by(simp add: finfun_Diag_def)
  1094 
  1094 
  1095 lemma finfun_Diag_update_update:
  1095 lemma finfun_Diag_update_update:
  1096   "(f(\<^sup>f a := b), g(\<^sup>f a' := c))\<^sup>f = (if a = a' then (f, g)\<^sup>f(\<^sup>f a := (b, c)) else (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))(\<^sup>f a' := (f\<^sub>f a', c)))"
  1096   "(f(\<^sup>f a := b), g(\<^sup>f a' := c))\<^sup>f = (if a = a' then (f, g)\<^sup>f(\<^sup>f a := (b, c)) else (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))(\<^sup>f a' := (f $ a', c)))"
  1097 by(auto simp add: finfun_Diag_update1 finfun_Diag_update2)
  1097 by(auto simp add: finfun_Diag_update1 finfun_Diag_update2)
  1098 
  1098 
  1099 lemma finfun_Diag_apply [simp]: "(f, g)\<^sup>f\<^sub>f = (\<lambda>x. (f\<^sub>f x, g\<^sub>f x))"
  1099 lemma finfun_Diag_apply [simp]: "op $ (f, g)\<^sup>f = (\<lambda>x. (f $ x, g $ x))"
  1100 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply intro: ext)
  1100 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply)
  1101 
  1101 
  1102 lemma finfun_Diag_conv_Abs_finfun:
  1102 lemma finfun_Diag_conv_Abs_finfun:
  1103   "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x)))"
  1103   "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (f $ x, g $ x)))"
  1104   including finfun
  1104   including finfun
  1105 proof -
  1105 proof -
  1106   have "(\<lambda>f :: 'a \<Rightarrow>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x))))"
  1106   have "(\<lambda>f :: 'a \<Rightarrow>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (f $ x, g $ x))))"
  1107   proof(rule finfun_rec_unique)
  1107   proof(rule finfun_rec_unique)
  1108     { fix c show "Abs_finfun (\<lambda>x. (finfun_apply (\<lambda>\<^isup>f c) x, finfun_apply g x)) = Pair c \<circ>\<^isub>f g"
  1108     { fix c show "Abs_finfun (\<lambda>x. ((\<lambda>\<^isup>f c) $ x, g $ x)) = Pair c \<circ>\<^isub>f g"
  1109         by(simp add: finfun_comp_conv_comp o_def finfun_const_def) }
  1109         by(simp add: finfun_comp_conv_comp o_def finfun_const_def) }
  1110     { fix g' a b
  1110     { fix g' a b
  1111       show "Abs_finfun (\<lambda>x. (finfun_apply g'(\<^sup>f a := b) x, finfun_apply g x)) =
  1111       show "Abs_finfun (\<lambda>x. (g'(\<^sup>f a := b) $ x, g $ x)) =
  1112             (Abs_finfun (\<lambda>x. (finfun_apply g' x, finfun_apply g x)))(\<^sup>f a := (b, g\<^sub>f a))"
  1112             (Abs_finfun (\<lambda>x. (g' $ x, g $ x)))(\<^sup>f a := (b, g $ a))"
  1113         by(auto simp add: finfun_update_def fun_eq_iff simp del: fun_upd_apply) simp }
  1113         by(auto simp add: finfun_update_def fun_eq_iff simp del: fun_upd_apply) simp }
  1114   qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1)
  1114   qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1)
  1115   thus ?thesis by(auto simp add: fun_eq_iff)
  1115   thus ?thesis by(auto simp add: fun_eq_iff)
  1116 qed
  1116 qed
  1117 
  1117 
  1163 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)
  1163 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)
  1164 
  1164 
  1165 subsection {* Currying for FinFuns *}
  1165 subsection {* Currying for FinFuns *}
  1166 
  1166 
  1167 definition finfun_curry :: "('a \<times> 'b) \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f 'b \<Rightarrow>f 'c"
  1167 definition finfun_curry :: "('a \<times> 'b) \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f 'b \<Rightarrow>f 'c"
  1168 where [code del]: "finfun_curry = finfun_rec (finfun_const \<circ> finfun_const) (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c)))"
  1168 where [code del]: "finfun_curry = finfun_rec (finfun_const \<circ> finfun_const) (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c)))"
  1169 
  1169 
  1170 interpretation finfun_curry_aux: finfun_rec_wf_aux "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))"
  1170 interpretation finfun_curry_aux: finfun_rec_wf_aux "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))"
  1171 apply(unfold_locales)
  1171 apply(unfold_locales)
  1172 apply(auto simp add: split_def finfun_update_twist finfun_upd_apply split_paired_all finfun_update_const_same)
  1172 apply(auto simp add: split_def finfun_update_twist finfun_upd_apply split_paired_all finfun_update_const_same)
  1173 done
  1173 done
  1174 
  1174 
  1175 interpretation finfun_curry: finfun_rec_wf "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))"
  1175 interpretation finfun_curry: finfun_rec_wf "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))"
  1176 proof(unfold_locales)
  1176 proof(unfold_locales)
  1177   fix b' b :: 'b
  1177   fix b' b :: 'b
  1178   assume fin: "finite (UNIV :: ('c \<times> 'a) set)"
  1178   assume fin: "finite (UNIV :: ('c \<times> 'a) set)"
  1179   hence fin1: "finite (UNIV :: 'c set)" and fin2: "finite (UNIV :: 'a set)"
  1179   hence fin1: "finite (UNIV :: 'c set)" and fin2: "finite (UNIV :: 'a set)"
  1180     unfolding UNIV_Times_UNIV[symmetric]
  1180     unfolding UNIV_Times_UNIV[symmetric]
  1181     by(fastforce dest: finite_cartesian_productD1 finite_cartesian_productD2)+
  1181     by(fastforce dest: finite_cartesian_productD1 finite_cartesian_productD2)+
  1182   note [simp] = Abs_finfun_inverse_finite[OF fin] Abs_finfun_inverse_finite[OF fin1] Abs_finfun_inverse_finite[OF fin2]
  1182   note [simp] = Abs_finfun_inverse_finite[OF fin] Abs_finfun_inverse_finite[OF fin1] Abs_finfun_inverse_finite[OF fin2]
  1183   { fix A :: "('c \<times> 'a) set"
  1183   { fix A :: "('c \<times> 'a) set"
  1184     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'"
  1184     interpret comp_fun_commute "\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))) a b'"
  1185       by(rule finfun_curry_aux.upd_left_comm)
  1185       by(rule finfun_curry_aux.upd_left_comm)
  1186     from fin have "finite A" by(auto intro: finite_subset)
  1186     from fin have "finite A" by(auto intro: finite_subset)
  1187     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))"
  1187     hence "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (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))"
  1188       by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def intro!: arg_cong[where f="Abs_finfun"] ext) }
  1188       by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def intro!: arg_cong[where f="Abs_finfun"] ext) }
  1189   from this[of UNIV]
  1189   from this[of UNIV]
  1190   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'"
  1190   show "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) UNIV = (finfun_const \<circ> finfun_const) b'"
  1191     by(simp add: finfun_const_def)
  1191     by(simp add: finfun_const_def)
  1192 qed
  1192 qed
  1193 
  1193 
  1194 lemma finfun_curry_const [simp, code]: "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1194 lemma finfun_curry_const [simp, code]: "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1195 by(simp add: finfun_curry_def)
  1195 by(simp add: finfun_curry_def)
  1196 
  1196 
  1197 lemma finfun_curry_update [simp]:
  1197 lemma finfun_curry_update [simp]:
  1198   "finfun_curry (f(\<^sup>f (a, b) := c)) = (finfun_curry f)(\<^sup>f a := ((finfun_curry f)\<^sub>f a)(\<^sup>f b := c))"
  1198   "finfun_curry (f(\<^sup>f (a, b) := c)) = (finfun_curry f)(\<^sup>f a := (finfun_curry f $ a)(\<^sup>f b := c))"
  1199   and finfun_curry_update_code [code]:
  1199   and finfun_curry_update_code [code]:
  1200   "finfun_curry (f(\<^sup>fc (a, b) := c)) = (finfun_curry f)(\<^sup>f a := ((finfun_curry f)\<^sub>f a)(\<^sup>f b := c))"
  1200   "finfun_curry (f(\<^sup>fc (a, b) := c)) = (finfun_curry f)(\<^sup>f a := (finfun_curry f $ a)(\<^sup>f b := c))"
  1201 by(simp_all add: finfun_curry_def)
  1201 by(simp_all add: finfun_curry_def)
  1202 
  1202 
  1203 lemma finfun_Abs_finfun_curry: assumes fin: "f \<in> finfun"
  1203 lemma finfun_Abs_finfun_curry: assumes fin: "f \<in> finfun"
  1204   shows "(\<lambda>a. Abs_finfun (curry f a)) \<in> finfun"
  1204   shows "(\<lambda>a. Abs_finfun (curry f a)) \<in> finfun"
  1205   including finfun
  1205   including finfun
  1220 proof -
  1220 proof -
  1221   have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a)))"
  1221   have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a)))"
  1222   proof(rule finfun_rec_unique)
  1222   proof(rule finfun_rec_unique)
  1223     fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp
  1223     fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp
  1224     fix f a
  1224     fix f a
  1225     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))"
  1225     show "finfun_curry (f(\<^sup>f a := c)) = (finfun_curry f)(\<^sup>f fst a := (finfun_curry f $ (fst a))(\<^sup>f snd a := c))"
  1226       by(cases a) simp
  1226       by(cases a) simp
  1227     show "Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1227     show "Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)"
  1228       by(simp add: finfun_curry_def finfun_const_def curry_def)
  1228       by(simp add: finfun_curry_def finfun_const_def curry_def)
  1229     fix g b
  1229     fix g b
  1230     show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (finfun_apply g(\<^sup>f a := b)) aa)) =
  1230     show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (op $ g(\<^sup>f a := b)) aa)) =
  1231       (Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))(\<^sup>f
  1231       (Abs_finfun (\<lambda>a. Abs_finfun (curry (op $ g) a)))(\<^sup>f
  1232       fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))\<^sub>f (fst a))(\<^sup>f snd a := b))"
  1232       fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (op $ g) a))) $ (fst a))(\<^sup>f snd a := b))"
  1233       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)
  1233       by(cases a)(auto intro!: ext arg_cong[where f=Abs_finfun] simp add: finfun_curry_def finfun_update_def finfun_Abs_finfun_curry)
  1234   qed
  1234   qed
  1235   thus ?thesis by(auto simp add: fun_eq_iff)
  1235   thus ?thesis by(auto simp add: fun_eq_iff)
  1236 qed
  1236 qed
  1237 
  1237 
  1238 subsection {* Executable equality for FinFuns *}
  1238 subsection {* Executable equality for FinFuns *}
  1261 by simp
  1261 by simp
  1262 
  1262 
  1263 subsection {* The domain of a FinFun as a FinFun *}
  1263 subsection {* The domain of a FinFun as a FinFun *}
  1264 
  1264 
  1265 definition finfun_dom :: "('a \<Rightarrow>f 'b) \<Rightarrow> ('a \<Rightarrow>f bool)"
  1265 definition finfun_dom :: "('a \<Rightarrow>f 'b) \<Rightarrow> ('a \<Rightarrow>f bool)"
  1266 where [code del]: "finfun_dom f = Abs_finfun (\<lambda>a. f\<^sub>f a \<noteq> finfun_default f)"
  1266 where [code del]: "finfun_dom f = Abs_finfun (\<lambda>a. f $ a \<noteq> finfun_default f)"
  1267 
  1267 
  1268 lemma finfun_dom_const:
  1268 lemma finfun_dom_const:
  1269   "finfun_dom ((\<lambda>\<^isup>f c) :: 'a \<Rightarrow>f 'b) = (\<lambda>\<^isup>f finite (UNIV :: 'a set) \<and> c \<noteq> undefined)"
  1269   "finfun_dom ((\<lambda>\<^isup>f c) :: 'a \<Rightarrow>f 'b) = (\<lambda>\<^isup>f finite (UNIV :: 'a set) \<and> c \<noteq> undefined)"
  1270 unfolding finfun_dom_def finfun_default_const
  1270 unfolding finfun_dom_def finfun_default_const
  1271 by(auto)(simp_all add: finfun_const_def)
  1271 by(auto)(simp_all add: finfun_const_def)
  1279   "finfun_dom ((\<lambda>\<^isup>f c) :: ('a :: card_UNIV) \<Rightarrow>f 'b) = 
  1279   "finfun_dom ((\<lambda>\<^isup>f c) :: ('a :: card_UNIV) \<Rightarrow>f 'b) = 
  1280    (if card_UNIV (TYPE('a)) = 0 then (\<lambda>\<^isup>f False) else FinFun.code_abort (\<lambda>_. finfun_dom (\<lambda>\<^isup>f c)))"
  1280    (if card_UNIV (TYPE('a)) = 0 then (\<lambda>\<^isup>f False) else FinFun.code_abort (\<lambda>_. finfun_dom (\<lambda>\<^isup>f c)))"
  1281 unfolding card_UNIV_eq_0_infinite_UNIV
  1281 unfolding card_UNIV_eq_0_infinite_UNIV
  1282 by(simp add: finfun_dom_const)
  1282 by(simp add: finfun_dom_const)
  1283 
  1283 
  1284 lemma finfun_dom_finfunI: "(\<lambda>a. f\<^sub>f a \<noteq> finfun_default f) \<in> finfun"
  1284 lemma finfun_dom_finfunI: "(\<lambda>a. f $ a \<noteq> finfun_default f) \<in> finfun"
  1285 using finite_finfun_default[of f]
  1285 using finite_finfun_default[of f]
  1286 by(simp add: finfun_def exI[where x=False])
  1286 by(simp add: finfun_def exI[where x=False])
  1287 
  1287 
  1288 lemma finfun_dom_update [simp]:
  1288 lemma finfun_dom_update [simp]:
  1289   "finfun_dom (f(\<^sup>f a := b)) = (finfun_dom f)(\<^sup>f a := (b \<noteq> finfun_default f))"
  1289   "finfun_dom (f(\<^sup>f a := b)) = (finfun_dom f)(\<^sup>f a := (b \<noteq> finfun_default f))"
  1295 
  1295 
  1296 lemma finfun_dom_update_code [code]:
  1296 lemma finfun_dom_update_code [code]:
  1297   "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)"
  1297   "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)"
  1298 by(simp)
  1298 by(simp)
  1299 
  1299 
  1300 lemma finite_finfun_dom: "finite {x. (finfun_dom f)\<^sub>f x}"
  1300 lemma finite_finfun_dom: "finite {x. finfun_dom f $ x}"
  1301 proof(induct f rule: finfun_weak_induct)
  1301 proof(induct f rule: finfun_weak_induct)
  1302   case (const b)
  1302   case (const b)
  1303   thus ?case
  1303   thus ?case
  1304     by (cases "finite (UNIV :: 'a set) \<and> b \<noteq> undefined")
  1304     by (cases "finite (UNIV :: 'a set) \<and> b \<noteq> undefined")
  1305       (auto simp add: finfun_dom_const UNIV_def [symmetric] Set.empty_def [symmetric])
  1305       (auto simp add: finfun_dom_const UNIV_def [symmetric] Set.empty_def [symmetric])
  1306 next
  1306 next
  1307   case (update f a b)
  1307   case (update f a b)
  1308   have "{x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} =
  1308   have "{x. finfun_dom f(\<^sup>f a := b) $ x} =
  1309     (if b = finfun_default f then {x. (finfun_dom f)\<^sub>f x} - {a} else insert a {x. (finfun_dom f)\<^sub>f x})"
  1309     (if b = finfun_default f then {x. finfun_dom f $ x} - {a} else insert a {x. finfun_dom f $ x})"
  1310     by (auto simp add: finfun_upd_apply split: split_if_asm)
  1310     by (auto simp add: finfun_upd_apply split: split_if_asm)
  1311   thus ?case using update by simp
  1311   thus ?case using update by simp
  1312 qed
  1312 qed
  1313 
  1313 
  1314 
  1314 
  1315 subsection {* The domain of a FinFun as a sorted list *}
  1315 subsection {* The domain of a FinFun as a sorted list *}
  1316 
  1316 
  1317 definition finfun_to_list :: "('a :: linorder) \<Rightarrow>f 'b \<Rightarrow> 'a list"
  1317 definition finfun_to_list :: "('a :: linorder) \<Rightarrow>f 'b \<Rightarrow> 'a list"
  1318 where
  1318 where
  1319   "finfun_to_list f = (THE xs. set xs = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs \<and> distinct xs)"
  1319   "finfun_to_list f = (THE xs. set xs = {x. finfun_dom f $ x} \<and> sorted xs \<and> distinct xs)"
  1320 
  1320 
  1321 lemma set_finfun_to_list [simp]: "set (finfun_to_list f) = {x. (finfun_dom f)\<^sub>f x}" (is ?thesis1)
  1321 lemma set_finfun_to_list [simp]: "set (finfun_to_list f) = {x. finfun_dom f $ x}" (is ?thesis1)
  1322   and sorted_finfun_to_list: "sorted (finfun_to_list f)" (is ?thesis2)
  1322   and sorted_finfun_to_list: "sorted (finfun_to_list f)" (is ?thesis2)
  1323   and distinct_finfun_to_list: "distinct (finfun_to_list f)" (is ?thesis3)
  1323   and distinct_finfun_to_list: "distinct (finfun_to_list f)" (is ?thesis3)
  1324 proof -
  1324 proof -
  1325   have "?thesis1 \<and> ?thesis2 \<and> ?thesis3"
  1325   have "?thesis1 \<and> ?thesis2 \<and> ?thesis3"
  1326     unfolding finfun_to_list_def
  1326     unfolding finfun_to_list_def
  1327     by(rule theI')(rule finite_sorted_distinct_unique finite_finfun_dom)+
  1327     by(rule theI')(rule finite_sorted_distinct_unique finite_finfun_dom)+
  1328   thus ?thesis1 ?thesis2 ?thesis3 by simp_all
  1328   thus ?thesis1 ?thesis2 ?thesis3 by simp_all
  1329 qed
  1329 qed
  1330 
  1330 
  1331 lemma finfun_const_False_conv_bot: "(\<lambda>\<^isup>f False)\<^sub>f = bot"
  1331 lemma finfun_const_False_conv_bot: "op $ (\<lambda>\<^isup>f False) = bot"
  1332 by auto
  1332 by auto
  1333 
  1333 
  1334 lemma finfun_const_True_conv_top: "(\<lambda>\<^isup>f True)\<^sub>f = top"
  1334 lemma finfun_const_True_conv_top: "op $ (\<lambda>\<^isup>f True) = top"
  1335 by auto
  1335 by auto
  1336 
  1336 
  1337 lemma finfun_to_list_const:
  1337 lemma finfun_to_list_const:
  1338   "finfun_to_list ((\<lambda>\<^isup>f c) :: ('a :: {linorder} \<Rightarrow>f 'b)) = 
  1338   "finfun_to_list ((\<lambda>\<^isup>f c) :: ('a :: {linorder} \<Rightarrow>f 'b)) = 
  1339   (if \<not> finite (UNIV :: 'a set) \<or> c = undefined then [] else THE xs. set xs = UNIV \<and> sorted xs \<and> distinct xs)"
  1339   (if \<not> finite (UNIV :: 'a set) \<or> c = undefined then [] else THE xs. set xs = UNIV \<and> sorted xs \<and> distinct xs)"
  1348 lemma remove1_insort_insert_same:
  1348 lemma remove1_insort_insert_same:
  1349   "x \<notin> set xs \<Longrightarrow> remove1 x (insort_insert x xs) = xs"
  1349   "x \<notin> set xs \<Longrightarrow> remove1 x (insort_insert x xs) = xs"
  1350 by (metis insort_insert_insort remove1_insort)
  1350 by (metis insort_insert_insort remove1_insort)
  1351 
  1351 
  1352 lemma finfun_dom_conv:
  1352 lemma finfun_dom_conv:
  1353   "(finfun_dom f)\<^sub>f x \<longleftrightarrow> f\<^sub>f x \<noteq> finfun_default f"
  1353   "finfun_dom f $ x \<longleftrightarrow> f $ x \<noteq> finfun_default f"
  1354 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_dom_const finfun_default_const finfun_default_update_const finfun_upd_apply)
  1354 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_dom_const finfun_default_const finfun_default_update_const finfun_upd_apply)
  1355 
  1355 
  1356 lemma finfun_to_list_update:
  1356 lemma finfun_to_list_update:
  1357   "finfun_to_list (f(\<^sup>f a := b)) = 
  1357   "finfun_to_list (f(\<^sup>f a := b)) = 
  1358   (if b = finfun_default f then List.remove1 a (finfun_to_list f) else List.insort_insert a (finfun_to_list f))"
  1358   (if b = finfun_default f then List.remove1 a (finfun_to_list f) else List.insort_insert a (finfun_to_list f))"
  1359 proof(subst finfun_to_list_def, rule the_equality)
  1359 proof(subst finfun_to_list_def, rule the_equality)
  1360   fix xs
  1360   fix xs
  1361   assume "set xs = {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} \<and> sorted xs \<and> distinct xs"
  1361   assume "set xs = {x. finfun_dom f(\<^sup>f a := b) $ x} \<and> sorted xs \<and> distinct xs"
  1362   hence eq: "set xs = {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x}"
  1362   hence eq: "set xs = {x. finfun_dom f(\<^sup>f a := b) $ x}"
  1363     and [simp]: "sorted xs" "distinct xs" by simp_all
  1363     and [simp]: "sorted xs" "distinct xs" by simp_all
  1364   show "xs = (if b = finfun_default f then remove1 a (finfun_to_list f) else insort_insert a (finfun_to_list f))"
  1364   show "xs = (if b = finfun_default f then remove1 a (finfun_to_list f) else insort_insert a (finfun_to_list f))"
  1365   proof(cases "b = finfun_default f")
  1365   proof(cases "b = finfun_default f")
  1366     case True [simp]
  1366     case True [simp]
  1367     show ?thesis
  1367     show ?thesis
  1368     proof(cases "(finfun_dom f)\<^sub>f a")
  1368     proof(cases "finfun_dom f $ a")
  1369       case True
  1369       case True
  1370       have "finfun_to_list f = insort_insert a xs"
  1370       have "finfun_to_list f = insort_insert a xs"
  1371         unfolding finfun_to_list_def
  1371         unfolding finfun_to_list_def
  1372       proof(rule the_equality)
  1372       proof(rule the_equality)
  1373         have "set (insort_insert a xs) = insert a (set xs)" by(simp add: set_insort_insert)
  1373         have "set (insort_insert a xs) = insert a (set xs)" by(simp add: set_insort_insert)
  1374         also note eq also
  1374         also note eq also
  1375         have "insert a {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} = {x. (finfun_dom f)\<^sub>f x}" using True
  1375         have "insert a {x. finfun_dom f(\<^sup>f a := b) $ x} = {x. finfun_dom f $ x}" using True
  1376           by(auto simp add: finfun_upd_apply split: split_if_asm)
  1376           by(auto simp add: finfun_upd_apply split: split_if_asm)
  1377         finally show 1: "set (insort_insert a xs) = {x. (finfun_dom f)\<^sub>f x} \<and> sorted (insort_insert a xs) \<and> distinct (insort_insert a xs)"
  1377         finally show 1: "set (insort_insert a xs) = {x. finfun_dom f $ x} \<and> sorted (insort_insert a xs) \<and> distinct (insort_insert a xs)"
  1378           by(simp add: sorted_insort_insert distinct_insort_insert)
  1378           by(simp add: sorted_insort_insert distinct_insort_insert)
  1379 
  1379 
  1380         fix xs'
  1380         fix xs'
  1381         assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'"
  1381         assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'"
  1382         thus "xs' = insort_insert a xs" using 1 by(auto dest: sorted_distinct_set_unique)
  1382         thus "xs' = insort_insert a xs" using 1 by(auto dest: sorted_distinct_set_unique)
  1383       qed
  1383       qed
  1384       with eq True show ?thesis by(simp add: remove1_insort_insert_same)
  1384       with eq True show ?thesis by(simp add: remove1_insort_insert_same)
  1385     next
  1385     next
  1386       case False
  1386       case False
  1387       hence "f\<^sub>f a = b" by(auto simp add: finfun_dom_conv)
  1387       hence "f $ a = b" by(auto simp add: finfun_dom_conv)
  1388       hence f: "f(\<^sup>f a := b) = f" by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1388       hence f: "f(\<^sup>f a := b) = f" by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1389       from eq have "finfun_to_list f = xs" unfolding f finfun_to_list_def
  1389       from eq have "finfun_to_list f = xs" unfolding f finfun_to_list_def
  1390         by(auto elim: sorted_distinct_set_unique intro!: the_equality)
  1390         by(auto elim: sorted_distinct_set_unique intro!: the_equality)
  1391       with eq False show ?thesis unfolding f by(simp add: remove1_idem)
  1391       with eq False show ?thesis unfolding f by(simp add: remove1_idem)
  1392     qed
  1392     qed
  1393   next
  1393   next
  1394     case False
  1394     case False
  1395     show ?thesis
  1395     show ?thesis
  1396     proof(cases "(finfun_dom f)\<^sub>f a")
  1396     proof(cases "finfun_dom f $ a")
  1397       case True
  1397       case True
  1398       have "finfun_to_list f = xs"
  1398       have "finfun_to_list f = xs"
  1399         unfolding finfun_to_list_def
  1399         unfolding finfun_to_list_def
  1400       proof(rule the_equality)
  1400       proof(rule the_equality)
  1401         have "finfun_dom f = finfun_dom f(\<^sup>f a := b)" using False True
  1401         have "finfun_dom f = finfun_dom f(\<^sup>f a := b)" using False True
  1402           by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1402           by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply)
  1403         with eq show 1: "set xs = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs \<and> distinct xs"
  1403         with eq show 1: "set xs = {x. finfun_dom f $ x} \<and> sorted xs \<and> distinct xs"
  1404           by(simp del: finfun_dom_update)
  1404           by(simp del: finfun_dom_update)
  1405         
  1405         
  1406         fix xs'
  1406         fix xs'
  1407         assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'"
  1407         assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'"
  1408         thus "xs' = xs" using 1 by(auto elim: sorted_distinct_set_unique)
  1408         thus "xs' = xs" using 1 by(auto elim: sorted_distinct_set_unique)
  1409       qed
  1409       qed
  1410       thus ?thesis using False True eq by(simp add: insort_insert_triv)
  1410       thus ?thesis using False True eq by(simp add: insort_insert_triv)
  1411     next
  1411     next
  1412       case False
  1412       case False
  1413       have "finfun_to_list f = remove1 a xs"
  1413       have "finfun_to_list f = remove1 a xs"
  1414         unfolding finfun_to_list_def
  1414         unfolding finfun_to_list_def
  1415       proof(rule the_equality)
  1415       proof(rule the_equality)
  1416         have "set (remove1 a xs) = set xs - {a}" by simp
  1416         have "set (remove1 a xs) = set xs - {a}" by simp
  1417         also note eq also
  1417         also note eq also
  1418         have "{x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} - {a} = {x. (finfun_dom f)\<^sub>f x}" using False
  1418         have "{x. finfun_dom f(\<^sup>f a := b) $ x} - {a} = {x. finfun_dom f $ x}" using False
  1419           by(auto simp add: finfun_upd_apply split: split_if_asm)
  1419           by(auto simp add: finfun_upd_apply split: split_if_asm)
  1420         finally show 1: "set (remove1 a xs) = {x. (finfun_dom f)\<^sub>f x} \<and> sorted (remove1 a xs) \<and> distinct (remove1 a xs)"
  1420         finally show 1: "set (remove1 a xs) = {x. finfun_dom f $ x} \<and> sorted (remove1 a xs) \<and> distinct (remove1 a xs)"
  1421           by(simp add: sorted_remove1)
  1421           by(simp add: sorted_remove1)
  1422         
  1422         
  1423         fix xs'
  1423         fix xs'
  1424         assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'"
  1424         assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'"
  1425         thus "xs' = remove1 a xs" using 1 by(blast intro: sorted_distinct_set_unique)
  1425         thus "xs' = remove1 a xs" using 1 by(blast intro: sorted_distinct_set_unique)
  1426       qed
  1426       qed
  1427       thus ?thesis using False eq `b \<noteq> finfun_default f` 
  1427       thus ?thesis using False eq `b \<noteq> finfun_default f` 
  1428         by (simp add: insort_insert_insort insort_remove1)
  1428         by (simp add: insort_insert_insort insort_remove1)
  1429     qed
  1429     qed