| 29708 |      1 | (*  Title:      HOL/Library/Mapping.thy
 | 
|  |      2 |     Author:     Florian Haftmann, TU Muenchen
 | 
|  |      3 | *)
 | 
|  |      4 | 
 | 
|  |      5 | header {* An abstract view on maps for code generation. *}
 | 
|  |      6 | 
 | 
|  |      7 | theory Mapping
 | 
|  |      8 | imports Map
 | 
|  |      9 | begin
 | 
|  |     10 | 
 | 
|  |     11 | subsection {* Type definition and primitive operations *}
 | 
|  |     12 | 
 | 
|  |     13 | datatype ('a, 'b) map = Map "'a \<rightharpoonup> 'b"
 | 
|  |     14 | 
 | 
|  |     15 | definition empty :: "('a, 'b) map" where
 | 
|  |     16 |   "empty = Map (\<lambda>_. None)"
 | 
|  |     17 | 
 | 
|  |     18 | primrec lookup :: "('a, 'b) map \<Rightarrow> 'a \<rightharpoonup> 'b" where
 | 
|  |     19 |   "lookup (Map f) = f"
 | 
|  |     20 | 
 | 
|  |     21 | primrec update :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'b) map \<Rightarrow> ('a, 'b) map" where
 | 
|  |     22 |   "update k v (Map f) = Map (f (k \<mapsto> v))"
 | 
|  |     23 | 
 | 
|  |     24 | primrec delete :: "'a \<Rightarrow> ('a, 'b) map \<Rightarrow> ('a, 'b) map" where
 | 
|  |     25 |   "delete k (Map f) = Map (f (k := None))"
 | 
|  |     26 | 
 | 
|  |     27 | primrec keys :: "('a, 'b) map \<Rightarrow> 'a set" where
 | 
|  |     28 |   "keys (Map f) = dom f"
 | 
|  |     29 | 
 | 
|  |     30 | 
 | 
|  |     31 | subsection {* Derived operations *}
 | 
|  |     32 | 
 | 
|  |     33 | definition size :: "('a, 'b) map \<Rightarrow> nat" where
 | 
|  |     34 |   "size m = (if finite (keys m) then card (keys m) else 0)"
 | 
|  |     35 | 
 | 
| 29814 |     36 | definition replace :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'b) map \<Rightarrow> ('a, 'b) map" where
 | 
|  |     37 |   "replace k v m = (if lookup m k = None then m else update k v m)"
 | 
|  |     38 | 
 | 
| 29708 |     39 | definition tabulate :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'b) map" where
 | 
|  |     40 |   "tabulate ks f = Map (map_of (map (\<lambda>k. (k, f k)) ks))"
 | 
|  |     41 | 
 | 
| 29826 |     42 | definition bulkload :: "'a list \<Rightarrow> (nat, 'a) map" where
 | 
|  |     43 |   "bulkload xs = Map (\<lambda>k. if k < length xs then Some (xs ! k) else None)"
 | 
|  |     44 | 
 | 
| 29708 |     45 | 
 | 
|  |     46 | subsection {* Properties *}
 | 
|  |     47 | 
 | 
|  |     48 | lemma lookup_inject:
 | 
|  |     49 |   "lookup m = lookup n \<longleftrightarrow> m = n"
 | 
|  |     50 |   by (cases m, cases n) simp
 | 
|  |     51 | 
 | 
|  |     52 | lemma lookup_empty [simp]:
 | 
|  |     53 |   "lookup empty = Map.empty"
 | 
|  |     54 |   by (simp add: empty_def)
 | 
|  |     55 | 
 | 
|  |     56 | lemma lookup_update [simp]:
 | 
|  |     57 |   "lookup (update k v m) = (lookup m) (k \<mapsto> v)"
 | 
|  |     58 |   by (cases m) simp
 | 
|  |     59 | 
 | 
|  |     60 | lemma lookup_delete:
 | 
|  |     61 |   "lookup (delete k m) k = None"
 | 
|  |     62 |   "k \<noteq> l \<Longrightarrow> lookup (delete k m) l = lookup m l"
 | 
|  |     63 |   by (cases m, simp)+
 | 
|  |     64 | 
 | 
|  |     65 | lemma lookup_tabulate:
 | 
|  |     66 |   "lookup (tabulate ks f) = (Some o f) |` set ks"
 | 
|  |     67 |   by (induct ks) (auto simp add: tabulate_def restrict_map_def expand_fun_eq)
 | 
|  |     68 | 
 | 
| 29826 |     69 | lemma lookup_bulkload:
 | 
|  |     70 |   "lookup (bulkload xs) = (\<lambda>k. if k < length xs then Some (xs ! k) else None)"
 | 
|  |     71 |   unfolding bulkload_def by simp
 | 
|  |     72 | 
 | 
| 29708 |     73 | lemma update_update:
 | 
|  |     74 |   "update k v (update k w m) = update k v m"
 | 
|  |     75 |   "k \<noteq> l \<Longrightarrow> update k v (update l w m) = update l w (update k v m)"
 | 
|  |     76 |   by (cases m, simp add: expand_fun_eq)+
 | 
|  |     77 | 
 | 
| 29814 |     78 | lemma replace_update:
 | 
|  |     79 |   "lookup m k = None \<Longrightarrow> replace k v m = m"
 | 
|  |     80 |   "lookup m k \<noteq> None \<Longrightarrow> replace k v m = update k v m"
 | 
|  |     81 |   by (auto simp add: replace_def)
 | 
|  |     82 | 
 | 
| 29708 |     83 | lemma delete_empty [simp]:
 | 
|  |     84 |   "delete k empty = empty"
 | 
|  |     85 |   by (simp add: empty_def)
 | 
|  |     86 | 
 | 
|  |     87 | lemma delete_update:
 | 
|  |     88 |   "delete k (update k v m) = delete k m"
 | 
|  |     89 |   "k \<noteq> l \<Longrightarrow> delete k (update l v m) = update l v (delete k m)"
 | 
|  |     90 |   by (cases m, simp add: expand_fun_eq)+
 | 
|  |     91 | 
 | 
|  |     92 | lemma update_delete [simp]:
 | 
|  |     93 |   "update k v (delete k m) = update k v m"
 | 
|  |     94 |   by (cases m) simp
 | 
|  |     95 | 
 | 
|  |     96 | lemma keys_empty [simp]:
 | 
|  |     97 |   "keys empty = {}"
 | 
|  |     98 |   unfolding empty_def by simp
 | 
|  |     99 | 
 | 
|  |    100 | lemma keys_update [simp]:
 | 
|  |    101 |   "keys (update k v m) = insert k (keys m)"
 | 
|  |    102 |   by (cases m) simp
 | 
|  |    103 | 
 | 
|  |    104 | lemma keys_delete [simp]:
 | 
|  |    105 |   "keys (delete k m) = keys m - {k}"
 | 
|  |    106 |   by (cases m) simp
 | 
|  |    107 | 
 | 
|  |    108 | lemma keys_tabulate [simp]:
 | 
|  |    109 |   "keys (tabulate ks f) = set ks"
 | 
|  |    110 |   by (auto simp add: tabulate_def dest: map_of_SomeD intro!: weak_map_of_SomeI)
 | 
|  |    111 | 
 | 
|  |    112 | lemma size_empty [simp]:
 | 
|  |    113 |   "size empty = 0"
 | 
|  |    114 |   by (simp add: size_def keys_empty)
 | 
|  |    115 | 
 | 
|  |    116 | lemma size_update:
 | 
|  |    117 |   "finite (keys m) \<Longrightarrow> size (update k v m) =
 | 
|  |    118 |     (if k \<in> keys m then size m else Suc (size m))"
 | 
|  |    119 |   by (simp add: size_def keys_update)
 | 
|  |    120 |     (auto simp only: card_insert card_Suc_Diff1)
 | 
|  |    121 | 
 | 
|  |    122 | lemma size_delete:
 | 
|  |    123 |   "size (delete k m) = (if k \<in> keys m then size m - 1 else size m)"
 | 
|  |    124 |   by (simp add: size_def keys_delete)
 | 
|  |    125 | 
 | 
|  |    126 | lemma size_tabulate:
 | 
|  |    127 |   "size (tabulate ks f) = length (remdups ks)"
 | 
|  |    128 |   by (simp add: size_def keys_tabulate distinct_card [of "remdups ks", symmetric])
 | 
|  |    129 | 
 | 
| 29831 |    130 | lemma bulkload_tabulate:
 | 
| 29826 |    131 |   "bulkload xs = tabulate [0..<length xs] (nth xs)"
 | 
| 29831 |    132 |   by (rule sym)
 | 
|  |    133 |     (auto simp add: bulkload_def tabulate_def expand_fun_eq map_of_eq_None_iff map_compose [symmetric] comp_def)
 | 
| 29826 |    134 | 
 | 
| 29708 |    135 | end |