| author | immler | 
| Tue, 04 Jul 2017 09:36:25 +0100 | |
| changeset 66252 | b73f94b366b7 | 
| parent 66010 | 2f7d39285a1a | 
| child 66583 | ac183ddc9fef | 
| permissions | -rw-r--r-- | 
| 3981 | 1 | (* Title: HOL/Map.thy | 
| 2 | Author: Tobias Nipkow, based on a theory by David von Oheimb | |
| 13908 | 3 | Copyright 1997-2003 TU Muenchen | 
| 3981 | 4 | |
| 60838 | 5 | The datatype of "maps"; strongly resembles maps in VDM. | 
| 3981 | 6 | *) | 
| 7 | ||
| 60758 | 8 | section \<open>Maps\<close> | 
| 13914 | 9 | |
| 15131 | 10 | theory Map | 
| 15140 | 11 | imports List | 
| 15131 | 12 | begin | 
| 3981 | 13 | |
| 61069 | 14 | type_synonym ('a, 'b) "map" = "'a \<Rightarrow> 'b option" (infixr "\<rightharpoonup>" 0)
 | 
| 19656 
09be06943252
tuned concrete syntax -- abbreviation/const_syntax;
 wenzelm parents: 
19378diff
changeset | 15 | |
| 19378 | 16 | abbreviation | 
| 60838 | 17 | empty :: "'a \<rightharpoonup> 'b" where | 
| 60839 | 18 | "empty \<equiv> \<lambda>x. None" | 
| 19378 | 19 | |
| 19656 
09be06943252
tuned concrete syntax -- abbreviation/const_syntax;
 wenzelm parents: 
19378diff
changeset | 20 | definition | 
| 61069 | 21 |   map_comp :: "('b \<rightharpoonup> 'c) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'c)"  (infixl "\<circ>\<^sub>m" 55) where
 | 
| 22 | "f \<circ>\<^sub>m g = (\<lambda>k. case g k of None \<Rightarrow> None | Some v \<Rightarrow> f v)" | |
| 19656 
09be06943252
tuned concrete syntax -- abbreviation/const_syntax;
 wenzelm parents: 
19378diff
changeset | 23 | |
| 20800 | 24 | definition | 
| 60839 | 25 |   map_add :: "('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'b)"  (infixl "++" 100) where
 | 
| 26 | "m1 ++ m2 = (\<lambda>x. case m2 x of None \<Rightarrow> m1 x | Some y \<Rightarrow> Some y)" | |
| 20800 | 27 | |
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
21210diff
changeset | 28 | definition | 
| 60839 | 29 |   restrict_map :: "('a \<rightharpoonup> 'b) \<Rightarrow> 'a set \<Rightarrow> ('a \<rightharpoonup> 'b)"  (infixl "|`"  110) where
 | 
| 30 | "m|`A = (\<lambda>x. if x \<in> A then m x else None)" | |
| 13910 | 31 | |
| 21210 | 32 | notation (latex output) | 
| 19656 
09be06943252
tuned concrete syntax -- abbreviation/const_syntax;
 wenzelm parents: 
19378diff
changeset | 33 |   restrict_map  ("_\<restriction>\<^bsub>_\<^esub>" [111,110] 110)
 | 
| 
09be06943252
tuned concrete syntax -- abbreviation/const_syntax;
 wenzelm parents: 
19378diff
changeset | 34 | |
| 20800 | 35 | definition | 
| 60839 | 36 |   dom :: "('a \<rightharpoonup> 'b) \<Rightarrow> 'a set" where
 | 
| 37 |   "dom m = {a. m a \<noteq> None}"
 | |
| 20800 | 38 | |
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
21210diff
changeset | 39 | definition | 
| 60839 | 40 |   ran :: "('a \<rightharpoonup> 'b) \<Rightarrow> 'b set" where
 | 
| 41 |   "ran m = {b. \<exists>a. m a = Some b}"
 | |
| 20800 | 42 | |
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
21210diff
changeset | 43 | definition | 
| 60839 | 44 |   map_le :: "('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> bool"  (infix "\<subseteq>\<^sub>m" 50) where
 | 
| 45 | "(m\<^sub>1 \<subseteq>\<^sub>m m\<^sub>2) \<longleftrightarrow> (\<forall>a \<in> dom m\<^sub>1. m\<^sub>1 a = m\<^sub>2 a)" | |
| 20800 | 46 | |
| 41229 
d797baa3d57c
replaced command 'nonterminals' by slightly modernized version 'nonterminal';
 wenzelm parents: 
39992diff
changeset | 47 | nonterminal maplets and maplet | 
| 14180 | 48 | |
| 5300 | 49 | syntax | 
| 61955 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 50 |   "_maplet"  :: "['a, 'a] \<Rightarrow> maplet"             ("_ /\<mapsto>/ _")
 | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 51 |   "_maplets" :: "['a, 'a] \<Rightarrow> maplet"             ("_ /[\<mapsto>]/ _")
 | 
| 60839 | 52 |   ""         :: "maplet \<Rightarrow> maplets"             ("_")
 | 
| 53 |   "_Maplets" :: "[maplet, maplets] \<Rightarrow> maplets" ("_,/ _")
 | |
| 61955 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 54 |   "_MapUpd"  :: "['a \<rightharpoonup> 'b, maplets] \<Rightarrow> 'a \<rightharpoonup> 'b" ("_/'(_')" [900, 0] 900)
 | 
| 60839 | 55 |   "_Map"     :: "maplets \<Rightarrow> 'a \<rightharpoonup> 'b"            ("(1[_])")
 | 
| 3981 | 56 | |
| 61955 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 57 | syntax (ASCII) | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 58 |   "_maplet"  :: "['a, 'a] \<Rightarrow> maplet"             ("_ /|->/ _")
 | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 59 |   "_maplets" :: "['a, 'a] \<Rightarrow> maplet"             ("_ /[|->]/ _")
 | 
| 14180 | 60 | |
| 5300 | 61 | translations | 
| 60839 | 62 | "_MapUpd m (_Maplets xy ms)" \<rightleftharpoons> "_MapUpd (_MapUpd m xy) ms" | 
| 63 | "_MapUpd m (_maplet x y)" \<rightleftharpoons> "m(x := CONST Some y)" | |
| 64 | "_Map ms" \<rightleftharpoons> "_MapUpd (CONST empty) ms" | |
| 65 | "_Map (_Maplets ms1 ms2)" \<leftharpoondown> "_MapUpd (_Map ms1) ms2" | |
| 66 | "_Maplets ms1 (_Maplets ms2 ms3)" \<leftharpoondown> "_Maplets (_Maplets ms1 ms2) ms3" | |
| 14180 | 67 | |
| 61955 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 68 | primrec map_of :: "('a \<times> 'b) list \<Rightarrow> 'a \<rightharpoonup> 'b"
 | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 69 | where | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 70 | "map_of [] = empty" | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 71 | | "map_of (p # ps) = (map_of ps)(fst p \<mapsto> snd p)" | 
| 5300 | 72 | |
| 61955 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 73 | definition map_upds :: "('a \<rightharpoonup> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'a \<rightharpoonup> 'b"
 | 
| 
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
 wenzelm parents: 
61799diff
changeset | 74 | where "map_upds m xs ys = m ++ map_of (rev (zip xs ys))" | 
| 34941 | 75 | translations | 
| 60839 | 76 | "_MapUpd m (_maplets x y)" \<rightleftharpoons> "CONST map_upds m x y" | 
| 25965 | 77 | |
| 60839 | 78 | lemma map_of_Cons_code [code]: | 
| 25965 | 79 | "map_of [] k = None" | 
| 80 | "map_of ((l, v) # ps) k = (if l = k then Some v else map_of ps k)" | |
| 81 | by simp_all | |
| 82 | ||
| 20800 | 83 | |
| 60758 | 84 | subsection \<open>@{term [source] empty}\<close>
 | 
| 13908 | 85 | |
| 20800 | 86 | lemma empty_upd_none [simp]: "empty(x := None) = empty" | 
| 60839 | 87 | by (rule ext) simp | 
| 13908 | 88 | |
| 89 | ||
| 60758 | 90 | subsection \<open>@{term [source] map_upd}\<close>
 | 
| 13908 | 91 | |
| 60839 | 92 | lemma map_upd_triv: "t k = Some x \<Longrightarrow> t(k\<mapsto>x) = t" | 
| 93 | by (rule ext) simp | |
| 13908 | 94 | |
| 60839 | 95 | lemma map_upd_nonempty [simp]: "t(k\<mapsto>x) \<noteq> empty" | 
| 20800 | 96 | proof | 
| 97 | assume "t(k \<mapsto> x) = empty" | |
| 98 | then have "(t(k \<mapsto> x)) k = None" by simp | |
| 99 | then show False by simp | |
| 100 | qed | |
| 13908 | 101 | |
| 20800 | 102 | lemma map_upd_eqD1: | 
| 103 | assumes "m(a\<mapsto>x) = n(a\<mapsto>y)" | |
| 104 | shows "x = y" | |
| 105 | proof - | |
| 41550 | 106 | from assms have "(m(a\<mapsto>x)) a = (n(a\<mapsto>y)) a" by simp | 
| 20800 | 107 | then show ?thesis by simp | 
| 108 | qed | |
| 14100 | 109 | |
| 20800 | 110 | lemma map_upd_Some_unfold: | 
| 60838 | 111 | "((m(a\<mapsto>b)) x = Some y) = (x = a \<and> b = y \<or> x \<noteq> a \<and> m x = Some y)" | 
| 24331 | 112 | by auto | 
| 14100 | 113 | |
| 20800 | 114 | lemma image_map_upd [simp]: "x \<notin> A \<Longrightarrow> m(x \<mapsto> y) ` A = m ` A" | 
| 24331 | 115 | by auto | 
| 15303 | 116 | |
| 60839 | 117 | lemma finite_range_updI: "finite (range f) \<Longrightarrow> finite (range (f(a\<mapsto>b)))" | 
| 24331 | 118 | unfolding image_def | 
| 119 | apply (simp (no_asm_use) add:full_SetCompr_eq) | |
| 120 | apply (rule finite_subset) | |
| 121 | prefer 2 apply assumption | |
| 122 | apply (auto) | |
| 123 | done | |
| 13908 | 124 | |
| 125 | ||
| 60758 | 126 | subsection \<open>@{term [source] map_of}\<close>
 | 
| 13908 | 127 | |
| 15304 | 128 | lemma map_of_eq_None_iff: | 
| 24331 | 129 | "(map_of xys x = None) = (x \<notin> fst ` (set xys))" | 
| 130 | by (induct xys) simp_all | |
| 15304 | 131 | |
| 20800 | 132 | lemma map_of_eq_Some_iff [simp]: | 
| 24331 | 133 | "distinct(map fst xys) \<Longrightarrow> (map_of xys x = Some y) = ((x,y) \<in> set xys)" | 
| 134 | apply (induct xys) | |
| 135 | apply simp | |
| 136 | apply (auto simp: map_of_eq_None_iff [symmetric]) | |
| 137 | done | |
| 15304 | 138 | |
| 20800 | 139 | lemma Some_eq_map_of_iff [simp]: | 
| 24331 | 140 | "distinct(map fst xys) \<Longrightarrow> (Some y = map_of xys x) = ((x,y) \<in> set xys)" | 
| 60839 | 141 | by (auto simp del: map_of_eq_Some_iff simp: map_of_eq_Some_iff [symmetric]) | 
| 15304 | 142 | |
| 17724 | 143 | lemma map_of_is_SomeI [simp]: "\<lbrakk> distinct(map fst xys); (x,y) \<in> set xys \<rbrakk> | 
| 20800 | 144 | \<Longrightarrow> map_of xys x = Some y" | 
| 24331 | 145 | apply (induct xys) | 
| 146 | apply simp | |
| 147 | apply force | |
| 148 | done | |
| 15304 | 149 | |
| 20800 | 150 | lemma map_of_zip_is_None [simp]: | 
| 24331 | 151 | "length xs = length ys \<Longrightarrow> (map_of (zip xs ys) x = None) = (x \<notin> set xs)" | 
| 152 | by (induct rule: list_induct2) simp_all | |
| 15110 
78b5636eabc7
Added a number of new thms and the new function remove1
 nipkow parents: 
14739diff
changeset | 153 | |
| 26443 | 154 | lemma map_of_zip_is_Some: | 
| 155 | assumes "length xs = length ys" | |
| 156 | shows "x \<in> set xs \<longleftrightarrow> (\<exists>y. map_of (zip xs ys) x = Some y)" | |
| 157 | using assms by (induct rule: list_induct2) simp_all | |
| 158 | ||
| 159 | lemma map_of_zip_upd: | |
| 160 | fixes x :: 'a and xs :: "'a list" and ys zs :: "'b list" | |
| 161 | assumes "length ys = length xs" | |
| 162 | and "length zs = length xs" | |
| 163 | and "x \<notin> set xs" | |
| 164 | and "map_of (zip xs ys)(x \<mapsto> y) = map_of (zip xs zs)(x \<mapsto> z)" | |
| 165 | shows "map_of (zip xs ys) = map_of (zip xs zs)" | |
| 166 | proof | |
| 167 | fix x' :: 'a | |
| 168 | show "map_of (zip xs ys) x' = map_of (zip xs zs) x'" | |
| 169 | proof (cases "x = x'") | |
| 170 | case True | |
| 171 | from assms True map_of_zip_is_None [of xs ys x'] | |
| 172 | have "map_of (zip xs ys) x' = None" by simp | |
| 173 | moreover from assms True map_of_zip_is_None [of xs zs x'] | |
| 174 | have "map_of (zip xs zs) x' = None" by simp | |
| 175 | ultimately show ?thesis by simp | |
| 176 | next | |
| 177 | case False from assms | |
| 178 | have "(map_of (zip xs ys)(x \<mapsto> y)) x' = (map_of (zip xs zs)(x \<mapsto> z)) x'" by auto | |
| 179 | with False show ?thesis by simp | |
| 180 | qed | |
| 181 | qed | |
| 182 | ||
| 183 | lemma map_of_zip_inject: | |
| 184 | assumes "length ys = length xs" | |
| 185 | and "length zs = length xs" | |
| 186 | and dist: "distinct xs" | |
| 187 | and map_of: "map_of (zip xs ys) = map_of (zip xs zs)" | |
| 188 | shows "ys = zs" | |
| 60839 | 189 | using assms(1) assms(2)[symmetric] | 
| 190 | using dist map_of | |
| 191 | proof (induct ys xs zs rule: list_induct3) | |
| 26443 | 192 | case Nil show ?case by simp | 
| 193 | next | |
| 194 | case (Cons y ys x xs z zs) | |
| 60758 | 195 | from \<open>map_of (zip (x#xs) (y#ys)) = map_of (zip (x#xs) (z#zs))\<close> | 
| 26443 | 196 | have map_of: "map_of (zip xs ys)(x \<mapsto> y) = map_of (zip xs zs)(x \<mapsto> z)" by simp | 
| 197 | from Cons have "length ys = length xs" and "length zs = length xs" | |
| 198 | and "x \<notin> set xs" by simp_all | |
| 199 | then have "map_of (zip xs ys) = map_of (zip xs zs)" using map_of by (rule map_of_zip_upd) | |
| 60758 | 200 | with Cons.hyps \<open>distinct (x # xs)\<close> have "ys = zs" by simp | 
| 26443 | 201 | moreover from map_of have "y = z" by (rule map_upd_eqD1) | 
| 202 | ultimately show ?case by simp | |
| 203 | qed | |
| 204 | ||
| 33635 | 205 | lemma map_of_zip_map: | 
| 206 | "map_of (zip xs (map f xs)) = (\<lambda>x. if x \<in> set xs then Some (f x) else None)" | |
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 207 | by (induct xs) (simp_all add: fun_eq_iff) | 
| 33635 | 208 | |
| 15110 
78b5636eabc7
Added a number of new thms and the new function remove1
 nipkow parents: 
14739diff
changeset | 209 | lemma finite_range_map_of: "finite (range (map_of xys))" | 
| 24331 | 210 | apply (induct xys) | 
| 211 | apply (simp_all add: image_constant) | |
| 212 | apply (rule finite_subset) | |
| 213 | prefer 2 apply assumption | |
| 214 | apply auto | |
| 215 | done | |
| 15110 
78b5636eabc7
Added a number of new thms and the new function remove1
 nipkow parents: 
14739diff
changeset | 216 | |
| 20800 | 217 | lemma map_of_SomeD: "map_of xs k = Some y \<Longrightarrow> (k, y) \<in> set xs" | 
| 60841 | 218 | by (induct xs) (auto split: if_splits) | 
| 13908 | 219 | |
| 20800 | 220 | lemma map_of_mapk_SomeI: | 
| 60839 | 221 | "inj f \<Longrightarrow> map_of t k = Some x \<Longrightarrow> | 
| 61032 
b57df8eecad6
standardized some occurences of ancient "split" alias
 haftmann parents: 
60841diff
changeset | 222 | map_of (map (case_prod (\<lambda>k. Pair (f k))) t) (f k) = Some x" | 
| 60839 | 223 | by (induct t) (auto simp: inj_eq) | 
| 13908 | 224 | |
| 60839 | 225 | lemma weak_map_of_SomeI: "(k, x) \<in> set l \<Longrightarrow> \<exists>x. map_of l k = Some x" | 
| 24331 | 226 | by (induct l) auto | 
| 13908 | 227 | |
| 20800 | 228 | lemma map_of_filter_in: | 
| 61032 
b57df8eecad6
standardized some occurences of ancient "split" alias
 haftmann parents: 
60841diff
changeset | 229 | "map_of xs k = Some z \<Longrightarrow> P k z \<Longrightarrow> map_of (filter (case_prod P) xs) k = Some z" | 
| 24331 | 230 | by (induct xs) auto | 
| 13908 | 231 | |
| 35607 | 232 | lemma map_of_map: | 
| 55466 | 233 | "map_of (map (\<lambda>(k, v). (k, f v)) xs) = map_option f \<circ> map_of xs" | 
| 60839 | 234 | by (induct xs) (auto simp: fun_eq_iff) | 
| 35607 | 235 | |
| 55466 | 236 | lemma dom_map_option: | 
| 237 | "dom (\<lambda>k. map_option (f k) (m k)) = dom m" | |
| 35607 | 238 | by (simp add: dom_def) | 
| 13908 | 239 | |
| 56545 | 240 | lemma dom_map_option_comp [simp]: | 
| 241 | "dom (map_option g \<circ> m) = dom m" | |
| 242 | using dom_map_option [of "\<lambda>_. g" m] by (simp add: comp_def) | |
| 243 | ||
| 13908 | 244 | |
| 60758 | 245 | subsection \<open>@{const map_option} related\<close>
 | 
| 13908 | 246 | |
| 55466 | 247 | lemma map_option_o_empty [simp]: "map_option f o empty = empty" | 
| 24331 | 248 | by (rule ext) simp | 
| 13908 | 249 | |
| 55466 | 250 | lemma map_option_o_map_upd [simp]: | 
| 60838 | 251 | "map_option f o m(a\<mapsto>b) = (map_option f o m)(a\<mapsto>f b)" | 
| 24331 | 252 | by (rule ext) simp | 
| 20800 | 253 | |
| 13908 | 254 | |
| 60758 | 255 | subsection \<open>@{term [source] map_comp} related\<close>
 | 
| 17391 | 256 | |
| 20800 | 257 | lemma map_comp_empty [simp]: | 
| 24331 | 258 | "m \<circ>\<^sub>m empty = empty" | 
| 259 | "empty \<circ>\<^sub>m m = empty" | |
| 60839 | 260 | by (auto simp: map_comp_def split: option.splits) | 
| 17391 | 261 | |
| 20800 | 262 | lemma map_comp_simps [simp]: | 
| 24331 | 263 | "m2 k = None \<Longrightarrow> (m1 \<circ>\<^sub>m m2) k = None" | 
| 264 | "m2 k = Some k' \<Longrightarrow> (m1 \<circ>\<^sub>m m2) k = m1 k'" | |
| 60839 | 265 | by (auto simp: map_comp_def) | 
| 17391 | 266 | |
| 267 | lemma map_comp_Some_iff: | |
| 24331 | 268 | "((m1 \<circ>\<^sub>m m2) k = Some v) = (\<exists>k'. m2 k = Some k' \<and> m1 k' = Some v)" | 
| 60839 | 269 | by (auto simp: map_comp_def split: option.splits) | 
| 17391 | 270 | |
| 271 | lemma map_comp_None_iff: | |
| 24331 | 272 | "((m1 \<circ>\<^sub>m m2) k = None) = (m2 k = None \<or> (\<exists>k'. m2 k = Some k' \<and> m1 k' = None)) " | 
| 60839 | 273 | by (auto simp: map_comp_def split: option.splits) | 
| 13908 | 274 | |
| 20800 | 275 | |
| 61799 | 276 | subsection \<open>\<open>++\<close>\<close> | 
| 13908 | 277 | |
| 14025 | 278 | lemma map_add_empty[simp]: "m ++ empty = m" | 
| 24331 | 279 | by(simp add: map_add_def) | 
| 13908 | 280 | |
| 14025 | 281 | lemma empty_map_add[simp]: "empty ++ m = m" | 
| 24331 | 282 | by (rule ext) (simp add: map_add_def split: option.split) | 
| 13908 | 283 | |
| 14025 | 284 | lemma map_add_assoc[simp]: "m1 ++ (m2 ++ m3) = (m1 ++ m2) ++ m3" | 
| 24331 | 285 | by (rule ext) (simp add: map_add_def split: option.split) | 
| 20800 | 286 | |
| 287 | lemma map_add_Some_iff: | |
| 24331 | 288 | "((m ++ n) k = Some x) = (n k = Some x | n k = None & m k = Some x)" | 
| 289 | by (simp add: map_add_def split: option.split) | |
| 14025 | 290 | |
| 20800 | 291 | lemma map_add_SomeD [dest!]: | 
| 24331 | 292 | "(m ++ n) k = Some x \<Longrightarrow> n k = Some x \<or> n k = None \<and> m k = Some x" | 
| 293 | by (rule map_add_Some_iff [THEN iffD1]) | |
| 13908 | 294 | |
| 60839 | 295 | lemma map_add_find_right [simp]: "n k = Some xx \<Longrightarrow> (m ++ n) k = Some xx" | 
| 24331 | 296 | by (subst map_add_Some_iff) fast | 
| 13908 | 297 | |
| 14025 | 298 | lemma map_add_None [iff]: "((m ++ n) k = None) = (n k = None & m k = None)" | 
| 24331 | 299 | by (simp add: map_add_def split: option.split) | 
| 13908 | 300 | |
| 60838 | 301 | lemma map_add_upd[simp]: "f ++ g(x\<mapsto>y) = (f ++ g)(x\<mapsto>y)" | 
| 24331 | 302 | by (rule ext) (simp add: map_add_def) | 
| 13908 | 303 | |
| 14186 | 304 | lemma map_add_upds[simp]: "m1 ++ (m2(xs[\<mapsto>]ys)) = (m1++m2)(xs[\<mapsto>]ys)" | 
| 24331 | 305 | by (simp add: map_upds_def) | 
| 14186 | 306 | |
| 32236 
0203e1006f1b
some lemmas about maps (contributed by Peter Lammich)
 krauss parents: 
31380diff
changeset | 307 | lemma map_add_upd_left: "m\<notin>dom e2 \<Longrightarrow> e1(m \<mapsto> u1) ++ e2 = (e1 ++ e2)(m \<mapsto> u1)" | 
| 
0203e1006f1b
some lemmas about maps (contributed by Peter Lammich)
 krauss parents: 
31380diff
changeset | 308 | by (rule ext) (auto simp: map_add_def dom_def split: option.split) | 
| 
0203e1006f1b
some lemmas about maps (contributed by Peter Lammich)
 krauss parents: 
31380diff
changeset | 309 | |
| 20800 | 310 | lemma map_of_append[simp]: "map_of (xs @ ys) = map_of ys ++ map_of xs" | 
| 24331 | 311 | unfolding map_add_def | 
| 312 | apply (induct xs) | |
| 313 | apply simp | |
| 314 | apply (rule ext) | |
| 63648 | 315 | apply (simp split: option.split) | 
| 24331 | 316 | done | 
| 13908 | 317 | |
| 14025 | 318 | lemma finite_range_map_of_map_add: | 
| 60839 | 319 | "finite (range f) \<Longrightarrow> finite (range (f ++ map_of l))" | 
| 24331 | 320 | apply (induct l) | 
| 321 | apply (auto simp del: fun_upd_apply) | |
| 322 | apply (erule finite_range_updI) | |
| 323 | done | |
| 13908 | 324 | |
| 20800 | 325 | lemma inj_on_map_add_dom [iff]: | 
| 24331 | 326 | "inj_on (m ++ m') (dom m') = inj_on m' (dom m')" | 
| 44890 
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
 nipkow parents: 
42163diff
changeset | 327 | by (fastforce simp: map_add_def dom_def inj_on_def split: option.splits) | 
| 20800 | 328 | |
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 329 | lemma map_upds_fold_map_upd: | 
| 35552 | 330 | "m(ks[\<mapsto>]vs) = foldl (\<lambda>m (k, v). m(k \<mapsto> v)) m (zip ks vs)" | 
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 331 | unfolding map_upds_def proof (rule sym, rule zip_obtain_same_length) | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 332 | fix ks :: "'a list" and vs :: "'b list" | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 333 | assume "length ks = length vs" | 
| 35552 | 334 | then show "foldl (\<lambda>m (k, v). m(k\<mapsto>v)) m (zip ks vs) = m ++ map_of (rev (zip ks vs))" | 
| 335 | by(induct arbitrary: m rule: list_induct2) simp_all | |
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 336 | qed | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 337 | |
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 338 | lemma map_add_map_of_foldr: | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 339 | "m ++ map_of ps = foldr (\<lambda>(k, v) m. m(k \<mapsto> v)) ps m" | 
| 60839 | 340 | by (induct ps) (auto simp: fun_eq_iff map_add_def) | 
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 341 | |
| 15304 | 342 | |
| 60758 | 343 | subsection \<open>@{term [source] restrict_map}\<close>
 | 
| 14100 | 344 | |
| 20800 | 345 | lemma restrict_map_to_empty [simp]: "m|`{} = empty"
 | 
| 24331 | 346 | by (simp add: restrict_map_def) | 
| 14186 | 347 | |
| 31380 | 348 | lemma restrict_map_insert: "f |` (insert a A) = (f |` A)(a := f a)" | 
| 60839 | 349 | by (auto simp: restrict_map_def) | 
| 31380 | 350 | |
| 20800 | 351 | lemma restrict_map_empty [simp]: "empty|`D = empty" | 
| 24331 | 352 | by (simp add: restrict_map_def) | 
| 14186 | 353 | |
| 15693 | 354 | lemma restrict_in [simp]: "x \<in> A \<Longrightarrow> (m|`A) x = m x" | 
| 24331 | 355 | by (simp add: restrict_map_def) | 
| 14100 | 356 | |
| 15693 | 357 | lemma restrict_out [simp]: "x \<notin> A \<Longrightarrow> (m|`A) x = None" | 
| 24331 | 358 | by (simp add: restrict_map_def) | 
| 14100 | 359 | |
| 15693 | 360 | lemma ran_restrictD: "y \<in> ran (m|`A) \<Longrightarrow> \<exists>x\<in>A. m x = Some y" | 
| 62390 | 361 | by (auto simp: restrict_map_def ran_def split: if_split_asm) | 
| 14100 | 362 | |
| 15693 | 363 | lemma dom_restrict [simp]: "dom (m|`A) = dom m \<inter> A" | 
| 62390 | 364 | by (auto simp: restrict_map_def dom_def split: if_split_asm) | 
| 14100 | 365 | |
| 15693 | 366 | lemma restrict_upd_same [simp]: "m(x\<mapsto>y)|`(-{x}) = m|`(-{x})"
 | 
| 24331 | 367 | by (rule ext) (auto simp: restrict_map_def) | 
| 14100 | 368 | |
| 15693 | 369 | lemma restrict_restrict [simp]: "m|`A|`B = m|`(A\<inter>B)" | 
| 24331 | 370 | by (rule ext) (auto simp: restrict_map_def) | 
| 14100 | 371 | |
| 20800 | 372 | lemma restrict_fun_upd [simp]: | 
| 24331 | 373 |   "m(x := y)|`D = (if x \<in> D then (m|`(D-{x}))(x := y) else m|`D)"
 | 
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 374 | by (simp add: restrict_map_def fun_eq_iff) | 
| 14186 | 375 | |
| 20800 | 376 | lemma fun_upd_None_restrict [simp]: | 
| 60839 | 377 |   "(m|`D)(x := None) = (if x \<in> D then m|`(D - {x}) else m|`D)"
 | 
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 378 | by (simp add: restrict_map_def fun_eq_iff) | 
| 14186 | 379 | |
| 20800 | 380 | lemma fun_upd_restrict: "(m|`D)(x := y) = (m|`(D-{x}))(x := y)"
 | 
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 381 | by (simp add: restrict_map_def fun_eq_iff) | 
| 14186 | 382 | |
| 20800 | 383 | lemma fun_upd_restrict_conv [simp]: | 
| 24331 | 384 |   "x \<in> D \<Longrightarrow> (m|`D)(x := y) = (m|`(D-{x}))(x := y)"
 | 
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 385 | by (simp add: restrict_map_def fun_eq_iff) | 
| 14186 | 386 | |
| 35159 
df38e92af926
added lemma map_of_map_restrict; generalized lemma dom_const
 haftmann parents: 
35115diff
changeset | 387 | lemma map_of_map_restrict: | 
| 
df38e92af926
added lemma map_of_map_restrict; generalized lemma dom_const
 haftmann parents: 
35115diff
changeset | 388 | "map_of (map (\<lambda>k. (k, f k)) ks) = (Some \<circ> f) |` set ks" | 
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 389 | by (induct ks) (simp_all add: fun_eq_iff restrict_map_insert) | 
| 35159 
df38e92af926
added lemma map_of_map_restrict; generalized lemma dom_const
 haftmann parents: 
35115diff
changeset | 390 | |
| 35619 | 391 | lemma restrict_complement_singleton_eq: | 
| 392 |   "f |` (- {x}) = f(x := None)"
 | |
| 39302 
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
 nipkow parents: 
39198diff
changeset | 393 | by (simp add: restrict_map_def fun_eq_iff) | 
| 35619 | 394 | |
| 14100 | 395 | |
| 60758 | 396 | subsection \<open>@{term [source] map_upds}\<close>
 | 
| 14025 | 397 | |
| 60838 | 398 | lemma map_upds_Nil1 [simp]: "m([] [\<mapsto>] bs) = m" | 
| 24331 | 399 | by (simp add: map_upds_def) | 
| 14025 | 400 | |
| 60838 | 401 | lemma map_upds_Nil2 [simp]: "m(as [\<mapsto>] []) = m" | 
| 24331 | 402 | by (simp add:map_upds_def) | 
| 20800 | 403 | |
| 60838 | 404 | lemma map_upds_Cons [simp]: "m(a#as [\<mapsto>] b#bs) = (m(a\<mapsto>b))(as[\<mapsto>]bs)" | 
| 24331 | 405 | by (simp add:map_upds_def) | 
| 14025 | 406 | |
| 60839 | 407 | lemma map_upds_append1 [simp]: "size xs < size ys \<Longrightarrow> | 
| 24331 | 408 | m(xs@[x] [\<mapsto>] ys) = m(xs [\<mapsto>] ys)(x \<mapsto> ys!size xs)" | 
| 60839 | 409 | apply(induct xs arbitrary: ys m) | 
| 24331 | 410 | apply (clarsimp simp add: neq_Nil_conv) | 
| 411 | apply (case_tac ys) | |
| 412 | apply simp | |
| 413 | apply simp | |
| 414 | done | |
| 14187 | 415 | |
| 20800 | 416 | lemma map_upds_list_update2_drop [simp]: | 
| 46588 
4895d7f1be42
removing some unnecessary premises from Map theory
 bulwahn parents: 
44921diff
changeset | 417 | "size xs \<le> i \<Longrightarrow> m(xs[\<mapsto>]ys[i:=y]) = m(xs[\<mapsto>]ys)" | 
| 24331 | 418 | apply (induct xs arbitrary: m ys i) | 
| 419 | apply simp | |
| 420 | apply (case_tac ys) | |
| 421 | apply simp | |
| 422 | apply (simp split: nat.split) | |
| 423 | done | |
| 14025 | 424 | |
| 20800 | 425 | lemma map_upd_upds_conv_if: | 
| 60838 | 426 | "(f(x\<mapsto>y))(xs [\<mapsto>] ys) = | 
| 60839 | 427 | (if x \<in> set(take (length ys) xs) then f(xs [\<mapsto>] ys) | 
| 60838 | 428 | else (f(xs [\<mapsto>] ys))(x\<mapsto>y))" | 
| 24331 | 429 | apply (induct xs arbitrary: x y ys f) | 
| 430 | apply simp | |
| 431 | apply (case_tac ys) | |
| 62390 | 432 | apply (auto split: if_split simp: fun_upd_twist) | 
| 24331 | 433 | done | 
| 14025 | 434 | |
| 435 | lemma map_upds_twist [simp]: | |
| 60839 | 436 | "a \<notin> set as \<Longrightarrow> m(a\<mapsto>b)(as[\<mapsto>]bs) = m(as[\<mapsto>]bs)(a\<mapsto>b)" | 
| 44890 
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
 nipkow parents: 
42163diff
changeset | 437 | using set_take_subset by (fastforce simp add: map_upd_upds_conv_if) | 
| 14025 | 438 | |
| 20800 | 439 | lemma map_upds_apply_nontin [simp]: | 
| 60839 | 440 | "x \<notin> set xs \<Longrightarrow> (f(xs[\<mapsto>]ys)) x = f x" | 
| 24331 | 441 | apply (induct xs arbitrary: ys) | 
| 442 | apply simp | |
| 443 | apply (case_tac ys) | |
| 444 | apply (auto simp: map_upd_upds_conv_if) | |
| 445 | done | |
| 14025 | 446 | |
| 20800 | 447 | lemma fun_upds_append_drop [simp]: | 
| 24331 | 448 | "size xs = size ys \<Longrightarrow> m(xs@zs[\<mapsto>]ys) = m(xs[\<mapsto>]ys)" | 
| 449 | apply (induct xs arbitrary: m ys) | |
| 450 | apply simp | |
| 451 | apply (case_tac ys) | |
| 452 | apply simp_all | |
| 453 | done | |
| 14300 | 454 | |
| 20800 | 455 | lemma fun_upds_append2_drop [simp]: | 
| 24331 | 456 | "size xs = size ys \<Longrightarrow> m(xs[\<mapsto>]ys@zs) = m(xs[\<mapsto>]ys)" | 
| 457 | apply (induct xs arbitrary: m ys) | |
| 458 | apply simp | |
| 459 | apply (case_tac ys) | |
| 460 | apply simp_all | |
| 461 | done | |
| 14300 | 462 | |
| 463 | ||
| 20800 | 464 | lemma restrict_map_upds[simp]: | 
| 465 | "\<lbrakk> length xs = length ys; set xs \<subseteq> D \<rbrakk> | |
| 466 | \<Longrightarrow> m(xs [\<mapsto>] ys)|`D = (m|`(D - set xs))(xs [\<mapsto>] ys)" | |
| 24331 | 467 | apply (induct xs arbitrary: m ys) | 
| 468 | apply simp | |
| 469 | apply (case_tac ys) | |
| 470 | apply simp | |
| 471 | apply (simp add: Diff_insert [symmetric] insert_absorb) | |
| 472 | apply (simp add: map_upd_upds_conv_if) | |
| 473 | done | |
| 14186 | 474 | |
| 475 | ||
| 60758 | 476 | subsection \<open>@{term [source] dom}\<close>
 | 
| 13908 | 477 | |
| 31080 | 478 | lemma dom_eq_empty_conv [simp]: "dom f = {} \<longleftrightarrow> f = empty"
 | 
| 44921 | 479 | by (auto simp: dom_def) | 
| 31080 | 480 | |
| 60839 | 481 | lemma domI: "m a = Some b \<Longrightarrow> a \<in> dom m" | 
| 482 | by (simp add: dom_def) | |
| 14100 | 483 | (* declare domI [intro]? *) | 
| 13908 | 484 | |
| 60839 | 485 | lemma domD: "a \<in> dom m \<Longrightarrow> \<exists>b. m a = Some b" | 
| 486 | by (cases "m a") (auto simp add: dom_def) | |
| 13908 | 487 | |
| 66010 | 488 | lemma domIff [iff, simp del, code_unfold]: "a \<in> dom m \<longleftrightarrow> m a \<noteq> None" | 
| 60839 | 489 | by (simp add: dom_def) | 
| 13908 | 490 | |
| 20800 | 491 | lemma dom_empty [simp]: "dom empty = {}"
 | 
| 60839 | 492 | by (simp add: dom_def) | 
| 13908 | 493 | |
| 20800 | 494 | lemma dom_fun_upd [simp]: | 
| 60839 | 495 |   "dom(f(x := y)) = (if y = None then dom f - {x} else insert x (dom f))"
 | 
| 496 | by (auto simp: dom_def) | |
| 13908 | 497 | |
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 498 | lemma dom_if: | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 499 |   "dom (\<lambda>x. if P x then f x else g x) = dom f \<inter> {x. P x} \<union> dom g \<inter> {x. \<not> P x}"
 | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 500 | by (auto split: if_splits) | 
| 13937 | 501 | |
| 15304 | 502 | lemma dom_map_of_conv_image_fst: | 
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 503 | "dom (map_of xys) = fst ` set xys" | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 504 | by (induct xys) (auto simp add: dom_if) | 
| 15304 | 505 | |
| 60839 | 506 | lemma dom_map_of_zip [simp]: "length xs = length ys \<Longrightarrow> dom (map_of (zip xs ys)) = set xs" | 
| 507 | by (induct rule: list_induct2) (auto simp: dom_if) | |
| 15110 
78b5636eabc7
Added a number of new thms and the new function remove1
 nipkow parents: 
14739diff
changeset | 508 | |
| 13908 | 509 | lemma finite_dom_map_of: "finite (dom (map_of l))" | 
| 60839 | 510 | by (induct l) (auto simp: dom_def insert_Collect [symmetric]) | 
| 13908 | 511 | |
| 20800 | 512 | lemma dom_map_upds [simp]: | 
| 60839 | 513 | "dom(m(xs[\<mapsto>]ys)) = set(take (length ys) xs) \<union> dom m" | 
| 24331 | 514 | apply (induct xs arbitrary: m ys) | 
| 515 | apply simp | |
| 516 | apply (case_tac ys) | |
| 517 | apply auto | |
| 518 | done | |
| 13910 | 519 | |
| 60839 | 520 | lemma dom_map_add [simp]: "dom (m ++ n) = dom n \<union> dom m" | 
| 521 | by (auto simp: dom_def) | |
| 13910 | 522 | |
| 20800 | 523 | lemma dom_override_on [simp]: | 
| 60839 | 524 | "dom (override_on f g A) = | 
| 525 |     (dom f  - {a. a \<in> A - dom g}) \<union> {a. a \<in> A \<inter> dom g}"
 | |
| 526 | by (auto simp: dom_def override_on_def) | |
| 13908 | 527 | |
| 60839 | 528 | lemma map_add_comm: "dom m1 \<inter> dom m2 = {} \<Longrightarrow> m1 ++ m2 = m2 ++ m1"
 | 
| 529 | by (rule ext) (force simp: map_add_def dom_def split: option.split) | |
| 20800 | 530 | |
| 32236 
0203e1006f1b
some lemmas about maps (contributed by Peter Lammich)
 krauss parents: 
31380diff
changeset | 531 | lemma map_add_dom_app_simps: | 
| 60839 | 532 | "m \<in> dom l2 \<Longrightarrow> (l1 ++ l2) m = l2 m" | 
| 533 | "m \<notin> dom l1 \<Longrightarrow> (l1 ++ l2) m = l2 m" | |
| 534 | "m \<notin> dom l2 \<Longrightarrow> (l1 ++ l2) m = l1 m" | |
| 535 | by (auto simp add: map_add_def split: option.split_asm) | |
| 32236 
0203e1006f1b
some lemmas about maps (contributed by Peter Lammich)
 krauss parents: 
31380diff
changeset | 536 | |
| 29622 | 537 | lemma dom_const [simp]: | 
| 35159 
df38e92af926
added lemma map_of_map_restrict; generalized lemma dom_const
 haftmann parents: 
35115diff
changeset | 538 | "dom (\<lambda>x. Some (f x)) = UNIV" | 
| 29622 | 539 | by auto | 
| 540 | ||
| 22230 | 541 | (* Due to John Matthews - could be rephrased with dom *) | 
| 542 | lemma finite_map_freshness: | |
| 543 | "finite (dom (f :: 'a \<rightharpoonup> 'b)) \<Longrightarrow> \<not> finite (UNIV :: 'a set) \<Longrightarrow> | |
| 544 | \<exists>x. f x = None" | |
| 60839 | 545 | by (bestsimp dest: ex_new_if_finite) | 
| 14027 | 546 | |
| 28790 | 547 | lemma dom_minus: | 
| 548 | "f x = None \<Longrightarrow> dom f - insert x A = dom f - A" | |
| 549 | unfolding dom_def by simp | |
| 550 | ||
| 551 | lemma insert_dom: | |
| 552 | "f x = Some y \<Longrightarrow> insert x (dom f) = dom f" | |
| 553 | unfolding dom_def by auto | |
| 554 | ||
| 35607 | 555 | lemma map_of_map_keys: | 
| 556 | "set xs = dom m \<Longrightarrow> map_of (map (\<lambda>k. (k, the (m k))) xs) = m" | |
| 557 | by (rule ext) (auto simp add: map_of_map_restrict restrict_map_def) | |
| 558 | ||
| 39379 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 559 | lemma map_of_eqI: | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 560 | assumes set_eq: "set (map fst xs) = set (map fst ys)" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 561 | assumes map_eq: "\<forall>k\<in>set (map fst xs). map_of xs k = map_of ys k" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 562 | shows "map_of xs = map_of ys" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 563 | proof (rule ext) | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 564 | fix k show "map_of xs k = map_of ys k" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 565 | proof (cases "map_of xs k") | 
| 60839 | 566 | case None | 
| 567 | then have "k \<notin> set (map fst xs)" by (simp add: map_of_eq_None_iff) | |
| 39379 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 568 | with set_eq have "k \<notin> set (map fst ys)" by simp | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 569 | then have "map_of ys k = None" by (simp add: map_of_eq_None_iff) | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 570 | with None show ?thesis by simp | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 571 | next | 
| 60839 | 572 | case (Some v) | 
| 573 | then have "k \<in> set (map fst xs)" by (auto simp add: dom_map_of_conv_image_fst [symmetric]) | |
| 39379 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 574 | with map_eq show ?thesis by auto | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 575 | qed | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 576 | qed | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 577 | |
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 578 | lemma map_of_eq_dom: | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 579 | assumes "map_of xs = map_of ys" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 580 | shows "fst ` set xs = fst ` set ys" | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 581 | proof - | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 582 | from assms have "dom (map_of xs) = dom (map_of ys)" by simp | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 583 | then show ?thesis by (simp add: dom_map_of_conv_image_fst) | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 584 | qed | 
| 
ab1b070aa412
moved lemmas map_of_eqI and map_of_eq_dom to Map.thy
 haftmann parents: 
39302diff
changeset | 585 | |
| 53820 | 586 | lemma finite_set_of_finite_maps: | 
| 60839 | 587 | assumes "finite A" "finite B" | 
| 588 |   shows "finite {m. dom m = A \<and> ran m \<subseteq> B}" (is "finite ?S")
 | |
| 53820 | 589 | proof - | 
| 590 |   let ?S' = "{m. \<forall>x. (x \<in> A \<longrightarrow> m x \<in> Some ` B) \<and> (x \<notin> A \<longrightarrow> m x = None)}"
 | |
| 591 | have "?S = ?S'" | |
| 592 | proof | |
| 60839 | 593 | show "?S \<subseteq> ?S'" by (auto simp: dom_def ran_def image_def) | 
| 53820 | 594 | show "?S' \<subseteq> ?S" | 
| 595 | proof | |
| 596 | fix m assume "m \<in> ?S'" | |
| 597 | hence 1: "dom m = A" by force | |
| 60839 | 598 | hence 2: "ran m \<subseteq> B" using \<open>m \<in> ?S'\<close> by (auto simp: dom_def ran_def) | 
| 53820 | 599 | from 1 2 show "m \<in> ?S" by blast | 
| 600 | qed | |
| 601 | qed | |
| 602 | with assms show ?thesis by(simp add: finite_set_of_finite_funs) | |
| 603 | qed | |
| 28790 | 604 | |
| 60839 | 605 | |
| 60758 | 606 | subsection \<open>@{term [source] ran}\<close>
 | 
| 14100 | 607 | |
| 60839 | 608 | lemma ranI: "m a = Some b \<Longrightarrow> b \<in> ran m" | 
| 609 | by (auto simp: ran_def) | |
| 14100 | 610 | (* declare ranI [intro]? *) | 
| 13908 | 611 | |
| 20800 | 612 | lemma ran_empty [simp]: "ran empty = {}"
 | 
| 60839 | 613 | by (auto simp: ran_def) | 
| 13908 | 614 | |
| 60839 | 615 | lemma ran_map_upd [simp]: "m a = None \<Longrightarrow> ran(m(a\<mapsto>b)) = insert b (ran m)" | 
| 616 | unfolding ran_def | |
| 24331 | 617 | apply auto | 
| 60839 | 618 | apply (subgoal_tac "aa \<noteq> a") | 
| 24331 | 619 | apply auto | 
| 620 | done | |
| 20800 | 621 | |
| 60839 | 622 | lemma ran_distinct: | 
| 623 | assumes dist: "distinct (map fst al)" | |
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 624 | shows "ran (map_of al) = snd ` set al" | 
| 60839 | 625 | using assms | 
| 626 | proof (induct al) | |
| 627 | case Nil | |
| 628 | then show ?case by simp | |
| 34979 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 629 | next | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 630 | case (Cons kv al) | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 631 | then have "ran (map_of al) = snd ` set al" by simp | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 632 | moreover from Cons.prems have "map_of al (fst kv) = None" | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 633 | by (simp add: map_of_eq_None_iff) | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 634 | ultimately show ?case by (simp only: map_of.simps ran_map_upd) simp | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 635 | qed | 
| 
8cb6e7a42e9c
more correspondence lemmas between related operations
 haftmann parents: 
34941diff
changeset | 636 | |
| 60057 | 637 | lemma ran_map_option: "ran (\<lambda>x. map_option f (m x)) = f ` ran m" | 
| 60839 | 638 | by (auto simp add: ran_def) | 
| 639 | ||
| 13910 | 640 | |
| 61799 | 641 | subsection \<open>\<open>map_le\<close>\<close> | 
| 13910 | 642 | |
| 13912 | 643 | lemma map_le_empty [simp]: "empty \<subseteq>\<^sub>m g" | 
| 60839 | 644 | by (simp add: map_le_def) | 
| 13910 | 645 | |
| 17724 | 646 | lemma upd_None_map_le [simp]: "f(x := None) \<subseteq>\<^sub>m f" | 
| 60839 | 647 | by (force simp add: map_le_def) | 
| 14187 | 648 | |
| 13910 | 649 | lemma map_le_upd[simp]: "f \<subseteq>\<^sub>m g ==> f(a := b) \<subseteq>\<^sub>m g(a := b)" | 
| 60839 | 650 | by (fastforce simp add: map_le_def) | 
| 13910 | 651 | |
| 17724 | 652 | lemma map_le_imp_upd_le [simp]: "m1 \<subseteq>\<^sub>m m2 \<Longrightarrow> m1(x := None) \<subseteq>\<^sub>m m2(x \<mapsto> y)" | 
| 60839 | 653 | by (force simp add: map_le_def) | 
| 14187 | 654 | |
| 20800 | 655 | lemma map_le_upds [simp]: | 
| 60839 | 656 | "f \<subseteq>\<^sub>m g \<Longrightarrow> f(as [\<mapsto>] bs) \<subseteq>\<^sub>m g(as [\<mapsto>] bs)" | 
| 24331 | 657 | apply (induct as arbitrary: f g bs) | 
| 658 | apply simp | |
| 659 | apply (case_tac bs) | |
| 660 | apply auto | |
| 661 | done | |
| 13908 | 662 | |
| 14033 | 663 | lemma map_le_implies_dom_le: "(f \<subseteq>\<^sub>m g) \<Longrightarrow> (dom f \<subseteq> dom g)" | 
| 60839 | 664 | by (fastforce simp add: map_le_def dom_def) | 
| 14033 | 665 | |
| 666 | lemma map_le_refl [simp]: "f \<subseteq>\<^sub>m f" | |
| 60839 | 667 | by (simp add: map_le_def) | 
| 14033 | 668 | |
| 14187 | 669 | lemma map_le_trans[trans]: "\<lbrakk> m1 \<subseteq>\<^sub>m m2; m2 \<subseteq>\<^sub>m m3\<rbrakk> \<Longrightarrow> m1 \<subseteq>\<^sub>m m3" | 
| 60839 | 670 | by (auto simp add: map_le_def dom_def) | 
| 14033 | 671 | |
| 672 | lemma map_le_antisym: "\<lbrakk> f \<subseteq>\<^sub>m g; g \<subseteq>\<^sub>m f \<rbrakk> \<Longrightarrow> f = g" | |
| 24331 | 673 | unfolding map_le_def | 
| 674 | apply (rule ext) | |
| 675 | apply (case_tac "x \<in> dom f", simp) | |
| 44890 
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
 nipkow parents: 
42163diff
changeset | 676 | apply (case_tac "x \<in> dom g", simp, fastforce) | 
| 24331 | 677 | done | 
| 14033 | 678 | |
| 60839 | 679 | lemma map_le_map_add [simp]: "f \<subseteq>\<^sub>m g ++ f" | 
| 680 | by (fastforce simp: map_le_def) | |
| 14033 | 681 | |
| 60839 | 682 | lemma map_le_iff_map_add_commute: "f \<subseteq>\<^sub>m f ++ g \<longleftrightarrow> f ++ g = g ++ f" | 
| 683 | by (fastforce simp: map_add_def map_le_def fun_eq_iff split: option.splits) | |
| 15304 | 684 | |
| 60839 | 685 | lemma map_add_le_mapE: "f ++ g \<subseteq>\<^sub>m h \<Longrightarrow> g \<subseteq>\<^sub>m h" | 
| 686 | by (fastforce simp: map_le_def map_add_def dom_def) | |
| 15303 | 687 | |
| 60839 | 688 | lemma map_add_le_mapI: "\<lbrakk> f \<subseteq>\<^sub>m h; g \<subseteq>\<^sub>m h \<rbrakk> \<Longrightarrow> f ++ g \<subseteq>\<^sub>m h" | 
| 689 | by (auto simp: map_le_def map_add_def dom_def split: option.splits) | |
| 15303 | 690 | |
| 63828 | 691 | lemma map_add_subsumed1: "f \<subseteq>\<^sub>m g \<Longrightarrow> f++g = g" | 
| 692 | by (simp add: map_add_le_mapI map_le_antisym) | |
| 693 | ||
| 694 | lemma map_add_subsumed2: "f \<subseteq>\<^sub>m g \<Longrightarrow> g++f = g" | |
| 695 | by (metis map_add_subsumed1 map_le_iff_map_add_commute) | |
| 696 | ||
| 31080 | 697 | lemma dom_eq_singleton_conv: "dom f = {x} \<longleftrightarrow> (\<exists>v. f = [x \<mapsto> v])"
 | 
| 63834 | 698 | (is "?lhs \<longleftrightarrow> ?rhs") | 
| 699 | proof | |
| 700 | assume ?rhs | |
| 701 | then show ?lhs by (auto split: if_split_asm) | |
| 31080 | 702 | next | 
| 63834 | 703 | assume ?lhs | 
| 704 | then obtain v where v: "f x = Some v" by auto | |
| 705 | show ?rhs | |
| 706 | proof | |
| 707 | show "f = [x \<mapsto> v]" | |
| 708 | proof (rule map_le_antisym) | |
| 709 | show "[x \<mapsto> v] \<subseteq>\<^sub>m f" | |
| 710 | using v by (auto simp add: map_le_def) | |
| 711 | show "f \<subseteq>\<^sub>m [x \<mapsto> v]" | |
| 712 |         using \<open>dom f = {x}\<close> \<open>f x = Some v\<close> by (auto simp add: map_le_def)
 | |
| 713 | qed | |
| 714 | qed | |
| 31080 | 715 | qed | 
| 716 | ||
| 35565 | 717 | |
| 60758 | 718 | subsection \<open>Various\<close> | 
| 35565 | 719 | |
| 720 | lemma set_map_of_compr: | |
| 721 | assumes distinct: "distinct (map fst xs)" | |
| 722 |   shows "set xs = {(k, v). map_of xs k = Some v}"
 | |
| 60839 | 723 | using assms | 
| 724 | proof (induct xs) | |
| 725 | case Nil | |
| 726 | then show ?case by simp | |
| 35565 | 727 | next | 
| 728 | case (Cons x xs) | |
| 729 | obtain k v where "x = (k, v)" by (cases x) blast | |
| 730 | with Cons.prems have "k \<notin> dom (map_of xs)" | |
| 731 | by (simp add: dom_map_of_conv_image_fst) | |
| 732 |   then have *: "insert (k, v) {(k, v). map_of xs k = Some v} =
 | |
| 733 |     {(k', v'). (map_of xs(k \<mapsto> v)) k' = Some v'}"
 | |
| 734 | by (auto split: if_splits) | |
| 735 |   from Cons have "set xs = {(k, v). map_of xs k = Some v}" by simp
 | |
| 60758 | 736 | with * \<open>x = (k, v)\<close> show ?case by simp | 
| 35565 | 737 | qed | 
| 738 | ||
| 739 | lemma map_of_inject_set: | |
| 740 | assumes distinct: "distinct (map fst xs)" "distinct (map fst ys)" | |
| 741 | shows "map_of xs = map_of ys \<longleftrightarrow> set xs = set ys" (is "?lhs \<longleftrightarrow> ?rhs") | |
| 742 | proof | |
| 743 | assume ?lhs | |
| 60758 | 744 |   moreover from \<open>distinct (map fst xs)\<close> have "set xs = {(k, v). map_of xs k = Some v}"
 | 
| 35565 | 745 | by (rule set_map_of_compr) | 
| 60758 | 746 |   moreover from \<open>distinct (map fst ys)\<close> have "set ys = {(k, v). map_of ys k = Some v}"
 | 
| 35565 | 747 | by (rule set_map_of_compr) | 
| 748 | ultimately show ?rhs by simp | |
| 749 | next | |
| 53374 
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
 wenzelm parents: 
53015diff
changeset | 750 | assume ?rhs show ?lhs | 
| 
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
 wenzelm parents: 
53015diff
changeset | 751 | proof | 
| 35565 | 752 | fix k | 
| 60839 | 753 | show "map_of xs k = map_of ys k" | 
| 754 | proof (cases "map_of xs k") | |
| 35565 | 755 | case None | 
| 60758 | 756 | with \<open>?rhs\<close> have "map_of ys k = None" | 
| 35565 | 757 | by (simp add: map_of_eq_None_iff) | 
| 53374 
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
 wenzelm parents: 
53015diff
changeset | 758 | with None show ?thesis by simp | 
| 35565 | 759 | next | 
| 760 | case (Some v) | |
| 60758 | 761 | with distinct \<open>?rhs\<close> have "map_of ys k = Some v" | 
| 35565 | 762 | by simp | 
| 53374 
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
 wenzelm parents: 
53015diff
changeset | 763 | with Some show ?thesis by simp | 
| 35565 | 764 | qed | 
| 765 | qed | |
| 766 | qed | |
| 767 | ||
| 3981 | 768 | end |