diff -r 2b58b308300c -r cf398bb8a8be src/HOL/Library/ExecutableSet.thy --- a/src/HOL/Library/ExecutableSet.thy Wed Nov 15 17:05:43 2006 +0100 +++ b/src/HOL/Library/ExecutableSet.thy Wed Nov 15 17:05:44 2006 +0100 @@ -13,20 +13,44 @@ instance set :: (eq) eq .. +definition + minus_set :: "'a set \ 'a set \ 'a set" + "minus_set xs ys = ys - xs" + +lemma [code inline]: + "op - = (\xs ys. minus_set ys xs)" + unfolding minus_set_def .. + +definition + subset :: "'a set \ 'a set \ bool" + subset_def: "subset = op \" + +lemmas [symmetric, code inline] = subset_def + lemma [code target: Set]: - "(A = B) \ (A \ B \ B \ A)" + "A = B \ A \ B \ B \ A" by blast lemma [code func]: - "Code_Generator.eq A B \ (A \ B \ B \ A)" - unfolding eq_def by blast + "Code_Generator.eq A B \ subset A B \ subset B A" + unfolding eq_def subset_def by blast + +lemma [code func]: + "subset A B \ (\x\A. x \ B)" + unfolding subset_def Set.subset_def .. lemma [code]: "a \ A \ (\x\A. x = a)" unfolding bex_triv_one_point1 .. +definition + filter_set :: "('a \ bool) \ 'a set \ 'a set" + filter_set_def: "filter_set P xs = {x\xs. P x}" -section {* HOL definitions *} +lemmas [symmetric, code inline] = filter_set_def + + +section {* Operations on lists *} subsection {* Basic definitions *} @@ -169,12 +193,12 @@ lemma iso_remove1: assumes distnct: "distinct xs" shows "set (remove1 x xs) = set xs - {x}" -using distnct set_remove1_eq by auto + using distnct set_remove1_eq by auto lemma iso_union: "set (unionl xs ys) = set xs \ set ys" unfolding unionl_def - by (induct xs arbitrary: ys) (simp_all add: iso_insert) + by (induct xs arbitrary: ys) (simp_all add: iso_insert) lemma iso_intersect: "set (intersect xs ys) = set xs \ set ys" @@ -183,18 +207,10 @@ lemma iso_subtract: fixes ys assumes distnct: "distinct ys" - shows "set (subtract xs ys) = set ys - set xs" + shows "set (subtract xs ys) = minus_set (set xs) (set ys)" and "distinct (subtract xs ys)" -unfolding subtract_def using distnct by (induct xs arbitrary: ys) (simp_all, auto) - -corollary iso_subtract': - fixes xs ys - assumes distnct: "distinct xs" - shows "set ((flip subtract) xs ys) = set xs - set ys" -proof - - from distnct iso_subtract have "set (subtract ys xs) = set xs - set ys" by auto - thus ?thesis unfolding flip_def by auto -qed + unfolding subtract_def minus_set_def + using distnct by (induct xs arbitrary: ys) auto lemma iso_map_distinct: "set (map_distinct f xs) = image f (set xs)" @@ -234,6 +250,9 @@ "Blex xs f = Bex (set xs) f" unfolding Blex_def flip_def by (induct xs) simp_all +lemma iso_filter: + "set (filter P xs) = filter_set P (set xs)" + unfolding filter_set_def by (induct xs) auto section {* code generator setup *} @@ -244,6 +263,11 @@ code_modulename SML ExecutableSet List + Set List + +code_modulename Haskell + ExecutableSet List + Set List definition [code inline]: "empty_list = []" @@ -257,8 +281,8 @@ lemma [code func]: "(xs \ 'a\eq set) \ ys = xs \ ys" .. -definition - "subtract' = flip subtract" +lemma [code func]: + "minus_set xs = minus_set (xs \ 'a\eq set)" .. lemma [code func]: "image (f \ 'a \ 'b\eq) = image f" .. @@ -275,12 +299,15 @@ lemma [code func]: "Bex (xs \ 'a\type set) = Bex xs" .. +lemma [code func]: + "filter_set P (xs \ 'a\type set) = filter_set P xs" .. + code_abstype "'a set" "'a list" where "{}" \ empty_list insert \ insertl "op \" \ unionl "op \" \ intersect - "op - \ 'a set \ 'a set \ 'a set" \ subtract' + minus_set \ subtract image \ map_distinct Union \ unions Inter \ intersects @@ -288,9 +315,10 @@ INTER \ map_inter Ball \ Blall Bex \ Blex + filter_set \ filter -code_gen "{}" insert "op \" "op \" "op - \ 'a set \ 'a set \ 'a set" - image Union Inter UNION INTER Ball Bex (SML -) +code_gen "{}" insert "op \" "op \" minus_set + image Union Inter UNION INTER Ball Bex filter_set (SML -) subsection {* type serializations *} @@ -325,5 +353,6 @@ "INTER" ("{*map_inter*}") "Ball" ("{*Blall*}") "Bex" ("{*Blex*}") + "filter_set" ("{*filter*}") end