src/HOL/List.thy
changeset 82692 8f0b2daa7eaa
parent 82691 b69e4da2604b
child 82693 81f64077eaab
equal deleted inserted replaced
82691:b69e4da2604b 82692:8f0b2daa7eaa
  5870 using sorted_map_remove1 [of "\<lambda>x. x"] by simp
  5870 using sorted_map_remove1 [of "\<lambda>x. x"] by simp
  5871 
  5871 
  5872 lemma sorted_butlast:
  5872 lemma sorted_butlast:
  5873   assumes "sorted xs"
  5873   assumes "sorted xs"
  5874   shows "sorted (butlast xs)"
  5874   shows "sorted (butlast xs)"
  5875   by (simp add: assms butlast_conv_take sorted_wrt_take)
  5875   by (simp add: assms butlast_conv_take)
  5876 
  5876 
  5877 lemma sorted_replicate [simp]: "sorted(replicate n x)"
  5877 lemma sorted_replicate [simp]: "sorted(replicate n x)"
  5878 by(induction n) (auto)
  5878 by(induction n) (auto)
  5879 
  5879 
  5880 lemma sorted_remdups[simp]:
  5880 lemma sorted_remdups[simp]:
  7277 
  7277 
  7278 lemma asym_lex: "asym R \<Longrightarrow> asym (lex R)"
  7278 lemma asym_lex: "asym R \<Longrightarrow> asym (lex R)"
  7279   by (meson asymI asymD irrefl_lex lexord_asym lexord_lex)
  7279   by (meson asymI asymD irrefl_lex lexord_asym lexord_lex)
  7280 
  7280 
  7281 lemma asym_lenlex: "asym R \<Longrightarrow> asym (lenlex R)"
  7281 lemma asym_lenlex: "asym R \<Longrightarrow> asym (lenlex R)"
  7282   by (simp add: lenlex_def asym_inv_image asym_less_than asym_lex asym_lex_prod)
  7282   by (simp add: lenlex_def asym_inv_image asym_less_than asym_lex)
  7283 
  7283 
  7284 lemma lenlex_append1:
  7284 lemma lenlex_append1:
  7285   assumes len: "(us,xs) \<in> lenlex R" and eq: "length vs = length ys"
  7285   assumes len: "(us,xs) \<in> lenlex R" and eq: "length vs = length ys"
  7286   shows "(us @ vs, xs @ ys) \<in> lenlex R"
  7286   shows "(us @ vs, xs @ ys) \<in> lenlex R"
  7287   using len
  7287   using len
  8031   by (auto simp add: Ball_def simp flip: less_iff_succ_less_eq)
  8031   by (auto simp add: Ball_def simp flip: less_iff_succ_less_eq)
  8032     (auto simp add: le_less)
  8032     (auto simp add: le_less)
  8033 
  8033 
  8034 lemma forall_atLeastAtMost_iff [code_unfold]:
  8034 lemma forall_atLeastAtMost_iff [code_unfold]:
  8035   \<open>(\<forall>n\<in>{a..b}. P n) \<longleftrightarrow> all_range P a (b + 1)\<close>
  8035   \<open>(\<forall>n\<in>{a..b}. P n) \<longleftrightarrow> all_range P a (b + 1)\<close>
  8036   by (simp add: atLeastAtMost_eq_range all_range_iff)
  8036   by (simp add: atLeastAtMost_eq_range)
  8037 
  8037 
  8038 lemma forall_greaterThanLessThan_iff [code_unfold]:
  8038 lemma forall_greaterThanLessThan_iff [code_unfold]:
  8039   \<open>(\<forall>n\<in>{a<..<b}. P n) \<longleftrightarrow> all_range P (a + 1) b\<close>
  8039   \<open>(\<forall>n\<in>{a<..<b}. P n) \<longleftrightarrow> all_range P (a + 1) b\<close>
  8040   by (simp add: greaterThanLessThan_eq_range)
  8040   by (simp add: greaterThanLessThan_eq_range)
  8041 
  8041 
  8102 end
  8102 end
  8103 
  8103 
  8104 
  8104 
  8105 subsubsection \<open>Special implementations\<close>
  8105 subsubsection \<open>Special implementations\<close>
  8106 
  8106 
       
  8107 context
       
  8108 begin
       
  8109 
       
  8110 qualified definition map_tailrec_rev :: \<open>('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'b list\<close> \<comment> \<open>only for code generation\<close>
       
  8111   where map_tailrec_rev [simp]: \<open>map_tailrec_rev f as bs = rev (map f as) @ bs\<close>
       
  8112 
  8107 text \<open>
  8113 text \<open>
  8108   Optional tail recursive version of \<^const>\<open>map\<close>. Can avoid
  8114   Optional tail recursive version of \<^const>\<open>map\<close>. Can avoid
  8109   stack overflow in some target languages. Do not use for proving.
  8115   stack overflow in some target languages. Do not use for proving.
  8110 \<close>
  8116 \<close>
  8111 
  8117 
  8112 fun map_tailrec_rev :: \<open>('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'b list\<close>
  8118 qualified lemma map_tailrec_rev_code [code, no_atp]:
  8113   where
  8119   \<open>map_tailrec_rev f [] bs = bs\<close>
  8114     \<open>map_tailrec_rev f [] bs = bs\<close>
  8120   \<open>map_tailrec_rev f (a # as) bs = map_tailrec_rev f as (f a # bs)\<close>
  8115   | \<open>map_tailrec_rev f (a # as) bs = map_tailrec_rev f as (f a # bs)\<close>
  8121   by simp_all
  8116 
  8122 
  8117 lemma map_tailrec_rev:
  8123 qualified definition map_tailrec :: \<open>('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close> \<comment> \<open>only for code generation\<close>
  8118   \<open>map_tailrec_rev f as bs = rev(map f as) @ bs\<close>
  8124   where map_tailrec_eq [simp]: \<open>map_tailrec = map\<close>
  8119   by (induction as arbitrary: bs) simp_all
  8125 
  8120 
  8126 qualified lemma map_tailrec_code [code, no_atp]:
  8121 definition map_tailrec :: \<open>('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close>
  8127   \<open>map_tailrec f as = rev (map_tailrec_rev f as [])\<close>
  8122   where \<open>map_tailrec f as = rev (map_tailrec_rev f as [])\<close>
  8128   by simp
  8123 
  8129 
  8124 text\<open>Code equation:\<close>
  8130 text \<open>Potential code equation:\<close>
  8125 lemma map_eq_map_tailrec:
  8131 
       
  8132 qualified lemma map_eq_map_tailrec:
  8126   \<open>map = map_tailrec\<close>
  8133   \<open>map = map_tailrec\<close>
  8127   by (simp add: fun_eq_iff map_tailrec_def map_tailrec_rev)
  8134   by simp
       
  8135 
       
  8136 end
  8128 
  8137 
  8129 definition map_filter :: \<open>('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close>
  8138 definition map_filter :: \<open>('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close>
  8130   where [code_post]: "map_filter f xs = map (the \<circ> f) (filter (\<lambda>x. f x \<noteq> None) xs)"
  8139   where [code_post]: "map_filter f xs = map (the \<circ> f) (filter (\<lambda>x. f x \<noteq> None) xs)"
  8131 
  8140 
  8132 text \<open>
  8141 text \<open>
  8152 begin
  8161 begin
  8153 
  8162 
  8154 qualified definition null :: \<open>'a list \<Rightarrow> bool\<close> \<comment> \<open>only for code generation\<close>
  8163 qualified definition null :: \<open>'a list \<Rightarrow> bool\<close> \<comment> \<open>only for code generation\<close>
  8155   where null_iff [code_abbrev, simp]: \<open>null xs \<longleftrightarrow> xs = []\<close>
  8164   where null_iff [code_abbrev, simp]: \<open>null xs \<longleftrightarrow> xs = []\<close>
  8156 
  8165 
  8157 lemma null_code [code, no_atp]:
  8166 qualified lemma null_code [code, no_atp]:
  8158   \<open>null [] \<longleftrightarrow> True\<close>
  8167   \<open>null [] \<longleftrightarrow> True\<close>
  8159   \<open>null (x # xs) \<longleftrightarrow> False\<close>
  8168   \<open>null (x # xs) \<longleftrightarrow> False\<close>
  8160   by simp_all
  8169   by simp_all
  8161 
  8170 
  8162 lemma equal_Nil_null [code_unfold, no_atp]:
  8171 qualified lemma equal_Nil_null [code_unfold, no_atp]:
  8163   \<open>HOL.equal xs [] \<longleftrightarrow> null xs\<close>
  8172   \<open>HOL.equal xs [] \<longleftrightarrow> null xs\<close>
  8164   \<open>HOL.equal [] = null\<close>
  8173   \<open>HOL.equal [] = null\<close>
  8165   by (auto simp add: equal)
  8174   by (auto simp add: equal)
  8166 
  8175 
  8167 end
  8176 qualified definition length_tailrec :: \<open>'a list \<Rightarrow> nat \<Rightarrow> nat\<close> \<comment> \<open>only for code generation\<close>
  8168 
  8177   where length_tailrec_eq [simp]: \<open>length_tailrec xs = (+) (length xs)\<close>
  8169 
  8178 
  8170 text \<open>optimized code (tail-recursive) for \<^term>\<open>length\<close>\<close>
  8179 text \<open>optimized code (tail-recursive) for \<^term>\<open>length\<close>\<close>
  8171 
  8180 
  8172 definition gen_length :: \<open>nat \<Rightarrow> 'a list \<Rightarrow> nat\<close>
  8181 qualified lemma length_tailrec_code [code, no_atp]:
  8173   where \<open>gen_length n xs = n + length xs\<close>
  8182   \<open>length_tailrec [] n = n\<close>
  8174 
  8183   \<open>length_tailrec (x # xs) n = length_tailrec xs (Suc n)\<close>
  8175 lemma gen_length_code [code]:
  8184   by simp_all
  8176   \<open>gen_length n [] = n\<close>
  8185 
  8177   \<open>gen_length n (x # xs) = gen_length (Suc n) xs\<close>
  8186 qualified lemma length_code [code, no_atp]:
  8178   by (simp_all add: gen_length_def)
  8187   \<open>length xs = length_tailrec xs 0\<close>
  8179 
  8188   by simp
  8180 lemma length_code [code]:
  8189 
  8181   \<open>length = gen_length 0\<close>
  8190 qualified definition maps :: \<open>('a \<Rightarrow> 'b list) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close> \<comment> \<open>only for code generation\<close>
  8182   by (simp add: gen_length_def fun_eq_iff)
  8191   where maps_eq [code_abbrev, simp]: \<open>maps f xs = concat (map f xs)\<close>
  8183 
       
  8184 hide_const (open) gen_length
       
  8185 
       
  8186 
       
  8187 definition maps :: \<open>('a \<Rightarrow> 'b list) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close>
       
  8188   where [code_abbrev]: \<open>maps f xs = concat (map f xs)\<close>
       
  8189 
  8192 
  8190 text \<open>
  8193 text \<open>
  8191   Operation \<^const>\<open>maps\<close> avoids
  8194   Operation \<^const>\<open>maps\<close> avoids
  8192   intermediate lists on execution -- do not use for proving.
  8195   intermediate lists on execution -- do not use for proving.
  8193 \<close>
  8196 \<close>
  8194 
  8197 
  8195 lemma maps_simps [code]:
  8198 qualified lemma maps_code [code, no_atp]:
       
  8199   \<open>maps f [] = []\<close>
  8196   \<open>maps f (x # xs) = f x @ maps f xs\<close>
  8200   \<open>maps f (x # xs) = f x @ maps f xs\<close>
  8197   \<open>maps f [] = []\<close>
  8201   by simp_all
  8198   by (simp_all add: maps_def)
  8202 
  8199 
  8203 end
  8200 hide_const (open) maps
       
  8201 
  8204 
  8202 
  8205 
  8203 subsubsection \<open>Implementation of sets by lists\<close>
  8206 subsubsection \<open>Implementation of sets by lists\<close>
  8204 
  8207 
  8205 lemma is_empty_set [code]:
  8208 lemma is_empty_set [code]:
  8710 
  8713 
  8711 lemma map_rec:
  8714 lemma map_rec:
  8712   "map f xs = rec_list Nil (%x _ y. Cons (f x) y) xs"
  8715   "map f xs = rec_list Nil (%x _ y. Cons (f x) y) xs"
  8713   by (induct xs) auto
  8716   by (induct xs) auto
  8714 
  8717 
  8715 lemma concat_map_maps: (* FIXME delete candidate *)
       
  8716   "concat (map f xs) = List.maps f xs"
       
  8717   by (simp add: maps_def)
       
  8718 
       
  8719 lemma Ball_set_list_all: (* FIXME delete candidate *)
  8718 lemma Ball_set_list_all: (* FIXME delete candidate *)
  8720   "Ball (set xs) P \<longleftrightarrow> list_all P xs"
  8719   "Ball (set xs) P \<longleftrightarrow> list_all P xs"
  8721   by (simp add: list_all_iff)
  8720   by (fact Ball_set)
  8722 
  8721 
  8723 lemma Bex_set_list_ex: (* FIXME delete candidate *)
  8722 lemma Bex_set_list_ex: (* FIXME delete candidate *)
  8724   "Bex (set xs) P \<longleftrightarrow> list_ex P xs"
  8723   "Bex (set xs) P \<longleftrightarrow> list_ex P xs"
  8725   by (simp add: list_ex_iff)
  8724   by (fact Bex_set)
  8726 
  8725 
  8727 end
  8726 end