src/HOL/Library/AList.thy
changeset 55414 eab03e9cee8a
parent 47397 d654c73e4b12
child 55466 786edc984c98
equal deleted inserted replaced
55413:a8e96847523c 55414:eab03e9cee8a
    77 lemma image_update [simp]:
    77 lemma image_update [simp]:
    78   "x \<notin> A \<Longrightarrow> map_of (update x y al) ` A = map_of al ` A"
    78   "x \<notin> A \<Longrightarrow> map_of (update x y al) ` A = map_of al ` A"
    79   by (simp add: update_conv')
    79   by (simp add: update_conv')
    80 
    80 
    81 definition updates :: "'key list \<Rightarrow> 'val list \<Rightarrow> ('key \<times> 'val) list \<Rightarrow> ('key \<times> 'val) list" where
    81 definition updates :: "'key list \<Rightarrow> 'val list \<Rightarrow> ('key \<times> 'val) list \<Rightarrow> ('key \<times> 'val) list" where
    82   "updates ks vs = fold (prod_case update) (zip ks vs)"
    82   "updates ks vs = fold (case_prod update) (zip ks vs)"
    83 
    83 
    84 lemma updates_simps [simp]:
    84 lemma updates_simps [simp]:
    85   "updates [] vs ps = ps"
    85   "updates [] vs ps = ps"
    86   "updates ks [] ps = ps"
    86   "updates ks [] ps = ps"
    87   "updates (k#ks) (v#vs) ps = updates ks vs (update k v ps)"
    87   "updates (k#ks) (v#vs) ps = updates ks vs (update k v ps)"
    92     (case vs of [] \<Rightarrow> ps | v # vs \<Rightarrow> updates ks vs (update k v ps))"
    92     (case vs of [] \<Rightarrow> ps | v # vs \<Rightarrow> updates ks vs (update k v ps))"
    93   by (cases vs) simp_all
    93   by (cases vs) simp_all
    94 
    94 
    95 lemma updates_conv': "map_of (updates ks vs al) = (map_of al)(ks[\<mapsto>]vs)"
    95 lemma updates_conv': "map_of (updates ks vs al) = (map_of al)(ks[\<mapsto>]vs)"
    96 proof -
    96 proof -
    97   have "map_of \<circ> fold (prod_case update) (zip ks vs) =
    97   have "map_of \<circ> fold (case_prod update) (zip ks vs) =
    98     fold (\<lambda>(k, v) f. f(k \<mapsto> v)) (zip ks vs) \<circ> map_of"
    98     fold (\<lambda>(k, v) f. f(k \<mapsto> v)) (zip ks vs) \<circ> map_of"
    99     by (rule fold_commute) (auto simp add: fun_eq_iff update_conv')
    99     by (rule fold_commute) (auto simp add: fun_eq_iff update_conv')
   100   then show ?thesis by (auto simp add: updates_def fun_eq_iff map_upds_fold_map_upd foldl_conv_fold split_def)
   100   then show ?thesis by (auto simp add: updates_def fun_eq_iff map_upds_fold_map_upd foldl_conv_fold split_def)
   101 qed
   101 qed
   102 
   102 
   109 proof -
   109 proof -
   110   have "distinct (fold
   110   have "distinct (fold
   111        (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k])
   111        (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k])
   112        (zip ks vs) (map fst al))"
   112        (zip ks vs) (map fst al))"
   113     by (rule fold_invariant [of "zip ks vs" "\<lambda>_. True"]) (auto intro: assms)
   113     by (rule fold_invariant [of "zip ks vs" "\<lambda>_. True"]) (auto intro: assms)
   114   moreover have "map fst \<circ> fold (prod_case update) (zip ks vs) =
   114   moreover have "map fst \<circ> fold (case_prod update) (zip ks vs) =
   115     fold (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k]) (zip ks vs) \<circ> map fst"
   115     fold (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k]) (zip ks vs) \<circ> map fst"
   116     by (rule fold_commute) (simp add: update_keys split_def prod_case_beta comp_def)
   116     by (rule fold_commute) (simp add: update_keys split_def case_prod_beta comp_def)
   117   ultimately show ?thesis by (simp add: updates_def fun_eq_iff)
   117   ultimately show ?thesis by (simp add: updates_def fun_eq_iff)
   118 qed
   118 qed
   119 
   119 
   120 lemma updates_append1[simp]: "size ks < size vs \<Longrightarrow>
   120 lemma updates_append1[simp]: "size ks < size vs \<Longrightarrow>
   121   updates (ks@[k]) vs al = update k (vs!size ks) (updates ks vs al)"
   121   updates (ks@[k]) vs al = update k (vs!size ks) (updates ks vs al)"
   337     (simp_all add: delete_update)
   337     (simp_all add: delete_update)
   338 
   338 
   339 lemma clearjunk_updates:
   339 lemma clearjunk_updates:
   340   "clearjunk (updates ks vs al) = updates ks vs (clearjunk al)"
   340   "clearjunk (updates ks vs al) = updates ks vs (clearjunk al)"
   341 proof -
   341 proof -
   342   have "clearjunk \<circ> fold (prod_case update) (zip ks vs) =
   342   have "clearjunk \<circ> fold (case_prod update) (zip ks vs) =
   343     fold (prod_case update) (zip ks vs) \<circ> clearjunk"
   343     fold (case_prod update) (zip ks vs) \<circ> clearjunk"
   344     by (rule fold_commute) (simp add: clearjunk_update prod_case_beta o_def)
   344     by (rule fold_commute) (simp add: clearjunk_update case_prod_beta o_def)
   345   then show ?thesis by (simp add: updates_def fun_eq_iff)
   345   then show ?thesis by (simp add: updates_def fun_eq_iff)
   346 qed
   346 qed
   347 
   347 
   348 lemma clearjunk_delete:
   348 lemma clearjunk_delete:
   349   "clearjunk (delete x al) = delete x (clearjunk al)"
   349   "clearjunk (delete x al) = delete x (clearjunk al)"
   442   by (simp add: merge_updates clearjunk_updates)
   442   by (simp add: merge_updates clearjunk_updates)
   443 
   443 
   444 lemma merge_conv':
   444 lemma merge_conv':
   445   "map_of (merge xs ys) = map_of xs ++ map_of ys"
   445   "map_of (merge xs ys) = map_of xs ++ map_of ys"
   446 proof -
   446 proof -
   447   have "map_of \<circ> fold (prod_case update) (rev ys) =
   447   have "map_of \<circ> fold (case_prod update) (rev ys) =
   448     fold (\<lambda>(k, v) m. m(k \<mapsto> v)) (rev ys) \<circ> map_of"
   448     fold (\<lambda>(k, v) m. m(k \<mapsto> v)) (rev ys) \<circ> map_of"
   449     by (rule fold_commute) (simp add: update_conv' prod_case_beta split_def fun_eq_iff)
   449     by (rule fold_commute) (simp add: update_conv' case_prod_beta split_def fun_eq_iff)
   450   then show ?thesis
   450   then show ?thesis
   451     by (simp add: merge_def map_add_map_of_foldr foldr_conv_fold fun_eq_iff)
   451     by (simp add: merge_def map_add_map_of_foldr foldr_conv_fold fun_eq_iff)
   452 qed
   452 qed
   453 
   453 
   454 corollary merge_conv:
   454 corollary merge_conv: