added theory More_List
authorhaftmann
Thu, 20 May 2010 16:35:54 +0200
changeset 37015efc202e1677e
parent 37014 f9681d9d1d56
child 37016 e938a0b5286e
added theory More_List
src/HOL/Library/Executable_Set.thy
src/HOL/Library/Fset.thy
src/HOL/Library/Library.thy
src/HOL/Library/List_Set.thy
src/HOL/ex/Codegenerator_Candidates.thy
     1.1 --- a/src/HOL/Library/Executable_Set.thy	Thu May 20 16:35:53 2010 +0200
     1.2 +++ b/src/HOL/Library/Executable_Set.thy	Thu May 20 16:35:54 2010 +0200
     1.3 @@ -50,8 +50,8 @@
     1.4    by simp
     1.5  
     1.6  lemma [code]:
     1.7 -  "x \<in> Set xs \<longleftrightarrow> member x xs"
     1.8 -  "x \<in> Coset xs \<longleftrightarrow> \<not> member x xs"
     1.9 +  "x \<in> Set xs \<longleftrightarrow> member xs x"
    1.10 +  "x \<in> Coset xs \<longleftrightarrow> \<not> member xs x"
    1.11    by (simp_all add: mem_iff)
    1.12  
    1.13  definition is_empty :: "'a set \<Rightarrow> bool" where
    1.14 @@ -232,36 +232,36 @@
    1.15  
    1.16  lemma inter_project [code]:
    1.17    "inter A (Set xs) = Set (List.filter (\<lambda>x. x \<in> A) xs)"
    1.18 -  "inter A (Coset xs) = foldl (\<lambda>A x. remove x A) A xs"
    1.19 -  by (simp add: inter project_def, simp add: Diff_eq [symmetric] minus_set)
    1.20 +  "inter A (Coset xs) = foldr remove xs A"
    1.21 +  by (simp add: inter project_def) (simp add: Diff_eq [symmetric] minus_set_foldr)
    1.22  
    1.23  lemma subtract_remove [code]:
    1.24 -  "subtract (Set xs) A = foldl (\<lambda>A x. remove x A) A xs"
    1.25 +  "subtract (Set xs) A = foldr remove xs A"
    1.26    "subtract (Coset xs) A = Set (List.filter (\<lambda>x. x \<in> A) xs)"
    1.27 -  by (auto simp add: minus_set)
    1.28 +  by (auto simp add: minus_set_foldr)
    1.29  
    1.30  lemma union_insert [code]:
    1.31 -  "union (Set xs) A = foldl (\<lambda>A x. insert x A) A xs"
    1.32 +  "union (Set xs) A = foldr insert xs A"
    1.33    "union (Coset xs) A = Coset (List.filter (\<lambda>x. x \<notin> A) xs)"
    1.34 -  by (auto simp add: union_set)
    1.35 +  by (auto simp add: union_set_foldr)
    1.36  
    1.37  lemma Inf_inf [code]:
    1.38 -  "Inf (Set xs) = foldl inf (top :: 'a::complete_lattice) xs"
    1.39 +  "Inf (Set xs) = foldr inf xs (top :: 'a::complete_lattice)"
    1.40    "Inf (Coset []) = (bot :: 'a::complete_lattice)"
    1.41 -  by (simp_all add: Inf_UNIV Inf_set_fold)
    1.42 +  by (simp_all add: Inf_UNIV Inf_set_foldr)
    1.43  
    1.44  lemma Sup_sup [code]:
    1.45 -  "Sup (Set xs) = foldl sup (bot :: 'a::complete_lattice) xs"
    1.46 +  "Sup (Set xs) = foldr sup xs (bot :: 'a::complete_lattice)"
    1.47    "Sup (Coset []) = (top :: 'a::complete_lattice)"
    1.48 -  by (simp_all add: Sup_UNIV Sup_set_fold)
    1.49 +  by (simp_all add: Sup_UNIV Sup_set_foldr)
    1.50  
    1.51  lemma Inter_inter [code]:
    1.52 -  "Inter (Set xs) = foldl inter (Coset []) xs"
    1.53 +  "Inter (Set xs) = foldr inter xs (Coset [])"
    1.54    "Inter (Coset []) = empty"
    1.55    unfolding Inter_def Inf_inf by simp_all
    1.56  
    1.57  lemma Union_union [code]:
    1.58 -  "Union (Set xs) = foldl union empty xs"
    1.59 +  "Union (Set xs) = foldr union xs empty"
    1.60    "Union (Coset []) = Coset []"
    1.61    unfolding Union_def Sup_sup by simp_all
    1.62  
     2.1 --- a/src/HOL/Library/Fset.thy	Thu May 20 16:35:53 2010 +0200
     2.2 +++ b/src/HOL/Library/Fset.thy	Thu May 20 16:35:54 2010 +0200
     2.3 @@ -4,7 +4,7 @@
     2.4  header {* Executable finite sets *}
     2.5  
     2.6  theory Fset
     2.7 -imports List_Set
     2.8 +imports List_Set More_List
     2.9  begin
    2.10  
    2.11  declare mem_def [simp]
    2.12 @@ -41,9 +41,9 @@
    2.13  code_datatype Set Coset
    2.14  
    2.15  lemma member_code [code]:
    2.16 -  "member (Set xs) y \<longleftrightarrow> List.member y xs"
    2.17 -  "member (Coset xs) y \<longleftrightarrow> \<not> List.member y xs"
    2.18 -  by (simp_all add: mem_iff fun_Compl_def bool_Compl_def)
    2.19 +  "member (Set xs) = List.member xs"
    2.20 +  "member (Coset xs) = Not \<circ> List.member xs"
    2.21 +  by (simp_all add: expand_fun_eq mem_iff fun_Compl_def bool_Compl_def)
    2.22  
    2.23  lemma member_image_UNIV [simp]:
    2.24    "member ` UNIV = UNIV"
    2.25 @@ -105,6 +105,7 @@
    2.26  
    2.27  end
    2.28  
    2.29 +
    2.30  subsection {* Basic operations *}
    2.31  
    2.32  definition is_empty :: "'a fset \<Rightarrow> bool" where
    2.33 @@ -128,7 +129,7 @@
    2.34  lemma insert_Set [code]:
    2.35    "insert x (Set xs) = Set (List.insert x xs)"
    2.36    "insert x (Coset xs) = Coset (removeAll x xs)"
    2.37 -  by (simp_all add: Set_def Coset_def set_insert)
    2.38 +  by (simp_all add: Set_def Coset_def)
    2.39  
    2.40  definition remove :: "'a \<Rightarrow> 'a fset \<Rightarrow> 'a fset" where
    2.41    [simp]: "remove x A = Fset (List_Set.remove x (member A))"
    2.42 @@ -175,9 +176,17 @@
    2.43  proof -
    2.44    have "Finite_Set.card (set (remdups xs)) = length (remdups xs)"
    2.45      by (rule distinct_card) simp
    2.46 -  then show ?thesis by (simp add: Set_def card_def)
    2.47 +  then show ?thesis by (simp add: Set_def)
    2.48  qed
    2.49  
    2.50 +lemma compl_Set [simp, code]:
    2.51 +  "- Set xs = Coset xs"
    2.52 +  by (simp add: Set_def Coset_def)
    2.53 +
    2.54 +lemma compl_Coset [simp, code]:
    2.55 +  "- Coset xs = Set xs"
    2.56 +  by (simp add: Set_def Coset_def)
    2.57 +
    2.58  
    2.59  subsection {* Derived operations *}
    2.60  
    2.61 @@ -198,39 +207,49 @@
    2.62  
    2.63  lemma inter_project [code]:
    2.64    "inf A (Set xs) = Set (List.filter (member A) xs)"
    2.65 -  "inf A (Coset xs) = foldl (\<lambda>A x. remove x A) A xs"
    2.66 +  "inf A (Coset xs) = foldr remove xs A"
    2.67  proof -
    2.68    show "inf A (Set xs) = Set (List.filter (member A) xs)"
    2.69      by (simp add: inter project_def Set_def)
    2.70 -  have "foldl (\<lambda>A x. List_Set.remove x A) (member A) xs =
    2.71 -    member (foldl (\<lambda>A x. Fset (List_Set.remove x (member A))) A xs)"
    2.72 -    by (rule foldl_apply) (simp add: expand_fun_eq)
    2.73 -  then show "inf A (Coset xs) = foldl (\<lambda>A x. remove x A) A xs"
    2.74 -    by (simp add: Diff_eq [symmetric] minus_set)
    2.75 +  have *: "\<And>x::'a. remove = (\<lambda>x. Fset \<circ> List_Set.remove x \<circ> member)"
    2.76 +    by (simp add: expand_fun_eq)
    2.77 +  have "member \<circ> fold (\<lambda>x. Fset \<circ> List_Set.remove x \<circ> member) xs =
    2.78 +    fold List_Set.remove xs \<circ> member"
    2.79 +    by (rule fold_apply) (simp add: expand_fun_eq)
    2.80 +  then have "fold List_Set.remove xs (member A) = 
    2.81 +    member (fold (\<lambda>x. Fset \<circ> List_Set.remove x \<circ> member) xs A)"
    2.82 +    by (simp add: expand_fun_eq)
    2.83 +  then have "inf A (Coset xs) = fold remove xs A"
    2.84 +    by (simp add: Diff_eq [symmetric] minus_set *)
    2.85 +  moreover have "\<And>x y :: 'a. Fset.remove y \<circ> Fset.remove x = Fset.remove x \<circ> Fset.remove y"
    2.86 +    by (auto simp add: List_Set.remove_def * intro: ext)
    2.87 +  ultimately show "inf A (Coset xs) = foldr remove xs A"
    2.88 +    by (simp add: foldr_fold)
    2.89  qed
    2.90  
    2.91  lemma subtract_remove [code]:
    2.92 -  "A - Set xs = foldl (\<lambda>A x. remove x A) A xs"
    2.93 +  "A - Set xs = foldr remove xs A"
    2.94    "A - Coset xs = Set (List.filter (member A) xs)"
    2.95 -proof -
    2.96 -  have "foldl (\<lambda>A x. List_Set.remove x A) (member A) xs =
    2.97 -    member (foldl (\<lambda>A x. Fset (List_Set.remove x (member A))) A xs)"
    2.98 -    by (rule foldl_apply) (simp add: expand_fun_eq)
    2.99 -  then show "A - Set xs = foldl (\<lambda>A x. remove x A) A xs"
   2.100 -    by (simp add: minus_set)
   2.101 -  show "A - Coset xs = Set (List.filter (member A) xs)"
   2.102 -    by (auto simp add: Coset_def Set_def)
   2.103 -qed
   2.104 +  by (simp_all only: diff_eq compl_Set compl_Coset inter_project)
   2.105  
   2.106  lemma union_insert [code]:
   2.107 -  "sup (Set xs) A = foldl (\<lambda>A x. insert x A) A xs"
   2.108 +  "sup (Set xs) A = foldr insert xs A"
   2.109    "sup (Coset xs) A = Coset (List.filter (Not \<circ> member A) xs)"
   2.110  proof -
   2.111 -  have "foldl (\<lambda>A x. Set.insert x A) (member A) xs =
   2.112 -    member (foldl (\<lambda>A x. Fset (Set.insert x (member A))) A xs)"
   2.113 -    by (rule foldl_apply) (simp add: expand_fun_eq)
   2.114 -  then show "sup (Set xs) A = foldl (\<lambda>A x. insert x A) A xs"
   2.115 -    by (simp add: union_set)
   2.116 +  have *: "\<And>x::'a. insert = (\<lambda>x. Fset \<circ> Set.insert x \<circ> member)"
   2.117 +    by (simp add: expand_fun_eq)
   2.118 +  have "member \<circ> fold (\<lambda>x. Fset \<circ> Set.insert x \<circ> member) xs =
   2.119 +    fold Set.insert xs \<circ> member"
   2.120 +    by (rule fold_apply) (simp add: expand_fun_eq)
   2.121 +  then have "fold Set.insert xs (member A) =
   2.122 +    member (fold (\<lambda>x. Fset \<circ> Set.insert x \<circ> member) xs A)"
   2.123 +    by (simp add: expand_fun_eq)
   2.124 +  then have "sup (Set xs) A = fold insert xs A"
   2.125 +    by (simp add: union_set *)
   2.126 +  moreover have "\<And>x y :: 'a. Fset.insert y \<circ> Fset.insert x = Fset.insert x \<circ> Fset.insert y"
   2.127 +    by (auto simp add: * intro: ext)
   2.128 +  ultimately show "sup (Set xs) A = foldr insert xs A"
   2.129 +    by (simp add: foldr_fold)
   2.130    show "sup (Coset xs) A = Coset (List.filter (Not \<circ> member A) xs)"
   2.131      by (auto simp add: Coset_def)
   2.132  qed
   2.133 @@ -242,17 +261,17 @@
   2.134    [simp]: "Infimum A = Inf (member A)"
   2.135  
   2.136  lemma Infimum_inf [code]:
   2.137 -  "Infimum (Set As) = foldl inf top As"
   2.138 +  "Infimum (Set As) = foldr inf As top"
   2.139    "Infimum (Coset []) = bot"
   2.140 -  by (simp_all add: Inf_set_fold Inf_UNIV)
   2.141 +  by (simp_all add: Inf_set_foldr Inf_UNIV)
   2.142  
   2.143  definition Supremum :: "'a fset \<Rightarrow> 'a" where
   2.144    [simp]: "Supremum A = Sup (member A)"
   2.145  
   2.146  lemma Supremum_sup [code]:
   2.147 -  "Supremum (Set As) = foldl sup bot As"
   2.148 +  "Supremum (Set As) = foldr sup As bot"
   2.149    "Supremum (Coset []) = top"
   2.150 -  by (simp_all add: Sup_set_fold Sup_UNIV)
   2.151 +  by (simp_all add: Sup_set_foldr Sup_UNIV)
   2.152  
   2.153  end
   2.154  
     3.1 --- a/src/HOL/Library/Library.thy	Thu May 20 16:35:53 2010 +0200
     3.2 +++ b/src/HOL/Library/Library.thy	Thu May 20 16:35:54 2010 +0200
     3.3 @@ -34,6 +34,7 @@
     3.4    ListVector
     3.5    Kleene_Algebra
     3.6    Mapping
     3.7 +  More_List
     3.8    Multiset
     3.9    Nat_Infinity
    3.10    Nested_Environment
     4.1 --- a/src/HOL/Library/List_Set.thy	Thu May 20 16:35:53 2010 +0200
     4.2 +++ b/src/HOL/Library/List_Set.thy	Thu May 20 16:35:54 2010 +0200
     4.3 @@ -4,7 +4,7 @@
     4.4  header {* Relating (finite) sets and lists *}
     4.5  
     4.6  theory List_Set
     4.7 -imports Main
     4.8 +imports Main More_List
     4.9  begin
    4.10  
    4.11  subsection {* Various additional set functions *}
    4.12 @@ -24,7 +24,7 @@
    4.13  
    4.14  lemma minus_fold_remove:
    4.15    assumes "finite A"
    4.16 -  shows "B - A = fold remove B A"
    4.17 +  shows "B - A = Finite_Set.fold remove B A"
    4.18  proof -
    4.19    have rem: "remove = (\<lambda>x A. A - {x})" by (simp add: expand_fun_eq remove_def)
    4.20    show ?thesis by (simp only: rem assms minus_fold_remove)
    4.21 @@ -72,15 +72,23 @@
    4.22  subsection {* Functorial set operations *}
    4.23  
    4.24  lemma union_set:
    4.25 -  "set xs \<union> A = foldl (\<lambda>A x. Set.insert x A) A xs"
    4.26 +  "set xs \<union> A = fold Set.insert xs A"
    4.27  proof -
    4.28    interpret fun_left_comm_idem Set.insert
    4.29      by (fact fun_left_comm_idem_insert)
    4.30    show ?thesis by (simp add: union_fold_insert fold_set)
    4.31  qed
    4.32  
    4.33 +lemma union_set_foldr:
    4.34 +  "set xs \<union> A = foldr Set.insert xs A"
    4.35 +proof -
    4.36 +  have "\<And>x y :: 'a. insert y \<circ> insert x = insert x \<circ> insert y"
    4.37 +    by (auto intro: ext)
    4.38 +  then show ?thesis by (simp add: union_set foldr_fold)
    4.39 +qed
    4.40 +
    4.41  lemma minus_set:
    4.42 -  "A - set xs = foldl (\<lambda>A x. remove x A) A xs"
    4.43 +  "A - set xs = fold remove xs A"
    4.44  proof -
    4.45    interpret fun_left_comm_idem remove
    4.46      by (fact fun_left_comm_idem_remove)
    4.47 @@ -88,6 +96,14 @@
    4.48      by (simp add: minus_fold_remove [of _ A] fold_set)
    4.49  qed
    4.50  
    4.51 +lemma minus_set_foldr:
    4.52 +  "A - set xs = foldr remove xs A"
    4.53 +proof -
    4.54 +  have "\<And>x y :: 'a. remove y \<circ> remove x = remove x \<circ> remove y"
    4.55 +    by (auto simp add: remove_def intro: ext)
    4.56 +  then show ?thesis by (simp add: minus_set foldr_fold)
    4.57 +qed
    4.58 +
    4.59  
    4.60  subsection {* Derived set operations *}
    4.61  
    4.62 @@ -111,4 +127,11 @@
    4.63    "A \<inter> B = project (\<lambda>x. x \<in> A) B"
    4.64    by (auto simp add: project_def)
    4.65  
    4.66 +
    4.67 +subsection {* Various lemmas *}
    4.68 +
    4.69 +lemma not_set_compl:
    4.70 +  "Not \<circ> set xs = - set xs"
    4.71 +  by (simp add: fun_Compl_def bool_Compl_def comp_def expand_fun_eq)
    4.72 +
    4.73  end
    4.74 \ No newline at end of file
     5.1 --- a/src/HOL/ex/Codegenerator_Candidates.thy	Thu May 20 16:35:53 2010 +0200
     5.2 +++ b/src/HOL/ex/Codegenerator_Candidates.thy	Thu May 20 16:35:54 2010 +0200
     5.3 @@ -13,6 +13,7 @@
     5.4    Fset
     5.5    Enum
     5.6    List_Prefix
     5.7 +  More_List
     5.8    Nat_Infinity
     5.9    Nested_Environment
    5.10    Option_ord