--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/AList_Upd_Del.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,139 @@
+(* Author: Tobias Nipkow *)
+
+section {* Association List Update and Deletion *}
+
+theory AList_Upd_Del
+imports Sorted_Less
+begin
+
+abbreviation "sorted1 ps \<equiv> sorted(map fst ps)"
+
+text{* Define own @{text map_of} function to avoid pulling in an unknown
+amount of lemmas implicitly (via the simpset). *}
+
+hide_const (open) map_of
+
+fun map_of :: "('a*'b)list \<Rightarrow> 'a \<Rightarrow> 'b option" where
+"map_of [] = (\<lambda>a. None)" |
+"map_of ((x,y)#ps) = (\<lambda>a. if x=a then Some y else map_of ps a)"
+
+text \<open>Updating into an association list:\<close>
+
+fun upd_list :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) list \<Rightarrow> ('a*'b) list" where
+"upd_list a b [] = [(a,b)]" |
+"upd_list a b ((x,y)#ps) =
+ (if a < x then (a,b)#(x,y)#ps else
+ if a=x then (a,b)#ps else (x,y) # upd_list a b ps)"
+
+fun del_list :: "'a::linorder \<Rightarrow> ('a*'b)list \<Rightarrow> ('a*'b)list" where
+"del_list a [] = []" |
+"del_list a ((x,y)#ps) = (if a=x then ps else (x,y) # del_list a ps)"
+
+
+subsection \<open>Lemmas for @{const map_of}\<close>
+
+lemma map_of_ins_list: "map_of (upd_list a b ps) = (map_of ps)(a := Some b)"
+by(induction ps) auto
+
+lemma map_of_append: "map_of (ps @ qs) a =
+ (case map_of ps a of None \<Rightarrow> map_of qs a | Some b \<Rightarrow> Some b)"
+by(induction ps)(auto)
+
+lemma map_of_None: "sorted (a # map fst ps) \<Longrightarrow> map_of ps a = None"
+by (induction ps) (auto simp: sorted_lems sorted_Cons_iff)
+
+lemma map_of_None2: "sorted (map fst ps @ [a]) \<Longrightarrow> map_of ps a = None"
+by (induction ps) (auto simp: sorted_lems)
+
+lemma map_of_del_list: "sorted1 ps \<Longrightarrow>
+ map_of(del_list a ps) = (map_of ps)(a := None)"
+by(induction ps) (auto simp: map_of_None sorted_lems fun_eq_iff)
+
+lemma map_of_sorted_Cons: "sorted (a # map fst ps) \<Longrightarrow> x < a \<Longrightarrow>
+ map_of ps x = None"
+by (meson less_trans map_of_None sorted_Cons_iff)
+
+lemma map_of_sorted_snoc: "sorted (map fst ps @ [a]) \<Longrightarrow> a \<le> x \<Longrightarrow>
+ map_of ps x = None"
+by (meson le_less_trans map_of_None2 not_less sorted_snoc_iff)
+
+lemmas map_of_sorteds = map_of_sorted_Cons map_of_sorted_snoc
+
+
+subsection \<open>Lemmas for @{const upd_list}\<close>
+
+lemma sorted_upd_list: "sorted1 ps \<Longrightarrow> sorted1 (upd_list a b ps)"
+apply(induction ps)
+ apply simp
+apply(case_tac ps)
+ apply auto
+done
+
+lemma upd_list_sorted1: "\<lbrakk> sorted (map fst ps @ [x]); a < x \<rbrakk> \<Longrightarrow>
+ upd_list a b (ps @ (x,y) # qs) = upd_list a b ps @ (x,y) # qs"
+by(induction ps) (auto simp: sorted_lems)
+
+lemma upd_list_sorted2: "\<lbrakk> sorted (map fst ps @ [x]); x \<le> a \<rbrakk> \<Longrightarrow>
+ upd_list a b (ps @ (x,y) # qs) = ps @ upd_list a b ((x,y)#qs)"
+by(induction ps) (auto simp: sorted_lems)
+
+lemmas upd_list_sorteds = upd_list_sorted1 upd_list_sorted2
+
+(*
+lemma set_ins_list[simp]: "set (ins_list x xs) = insert x (set xs)"
+by(induction xs) auto
+
+lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
+apply(induction xs rule: sorted.induct)
+apply auto
+by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
+
+lemma set_del_list_eq [simp]: "distinct xs ==> set(del_list x xs) = set xs - {x}"
+apply(induct xs)
+ apply simp
+apply simp
+apply blast
+done
+*)
+
+
+subsection \<open>Lemmas for @{const del_list}\<close>
+
+lemma sorted_del_list: "sorted1 ps \<Longrightarrow> sorted1 (del_list x ps)"
+apply(induction ps)
+ apply simp
+apply(case_tac ps)
+apply auto
+by (meson order.strict_trans sorted_Cons_iff)
+
+lemma del_list_idem: "x \<notin> set(map fst xs) \<Longrightarrow> del_list x xs = xs"
+by (induct xs) auto
+
+lemma del_list_sorted1: "sorted1 (xs @ [(x,y)]) \<Longrightarrow> x \<le> a \<Longrightarrow>
+ del_list a (xs @ (x,y) # ys) = xs @ del_list a ((x,y) # ys)"
+by (induction xs) (auto simp: sorted_mid_iff2)
+
+lemma del_list_sorted2: "sorted1 (xs @ (x,y) # ys) \<Longrightarrow> a < x \<Longrightarrow>
+ del_list a (xs @ (x,y) # ys) = del_list a xs @ (x,y) # ys"
+by (induction xs) (fastforce simp: sorted_Cons_iff intro!: del_list_idem)+
+
+lemma del_list_sorted3:
+ "sorted1 (xs @ (x,x') # ys @ (y,y') # zs) \<Longrightarrow> a < y \<Longrightarrow>
+ del_list a (xs @ (x,x') # ys @ (y,y') # zs) = del_list a (xs @ (x,x') # ys) @ (y,y') # zs"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted2 ball_Un)
+
+lemma del_list_sorted4:
+ "sorted1 (xs @ (x,x') # ys @ (y,y') # zs @ (z,z') # us) \<Longrightarrow> a < z \<Longrightarrow>
+ del_list a (xs @ (x,x') # ys @ (y,y') # zs @ (z,z') # us) = del_list a (xs @ (x,x') # ys @ (y,y') # zs) @ (z,z') # us"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted3)
+
+lemma del_list_sorted5:
+ "sorted1 (xs @ (x,x') # ys @ (y,y') # zs @ (z,z') # us @ (u,u') # vs) \<Longrightarrow> a < u \<Longrightarrow>
+ del_list a (xs @ (x,x') # ys @ (y,y') # zs @ (z,z') # us @ (u,u') # vs) =
+ del_list a (xs @ (x,x') # ys @ (y,y') # zs @ (z,z') # us) @ (u,u') # vs"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted4)
+
+lemmas del_list_sorted =
+ del_list_sorted1 del_list_sorted2 del_list_sorted3 del_list_sorted4 del_list_sorted5
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Less_False.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,31 @@
+(* Author: Tobias Nipkow *)
+
+section {* Improved Simproc for $<$ *}
+
+theory Less_False
+imports Main
+begin
+
+simproc_setup less_False ("(x::'a::order) < y") = {* fn _ => fn ctxt => fn ct =>
+ let
+ fun prp t thm = Thm.full_prop_of thm aconv t;
+
+ val eq_False_if_not = @{thm eq_False} RS iffD2
+
+ fun prove_less_False ((less as Const(_,T)) $ r $ s) =
+ let val prems = Simplifier.prems_of ctxt;
+ val le = Const (@{const_name less_eq}, T);
+ val t = HOLogic.mk_Trueprop(le $ s $ r);
+ in case find_first (prp t) prems of
+ NONE =>
+ let val t = HOLogic.mk_Trueprop(less $ s $ r)
+ in case find_first (prp t) prems of
+ NONE => NONE
+ | SOME thm => SOME(mk_meta_eq((thm RS @{thm less_not_sym}) RS eq_False_if_not))
+ end
+ | SOME thm => NONE
+ end;
+ in prove_less_False (Thm.term_of ct) end
+*}
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/List_Ins_Del.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,122 @@
+(* Author: Tobias Nipkow *)
+
+section {* List Insertion and Deletion *}
+
+theory List_Ins_Del
+imports Sorted_Less
+begin
+
+subsection \<open>Elements in a list\<close>
+
+fun elems :: "'a list \<Rightarrow> 'a set" where
+"elems [] = {}" |
+"elems (x#xs) = Set.insert x (elems xs)"
+
+lemma elems_app: "elems (xs @ ys) = (elems xs \<union> elems ys)"
+by (induction xs) auto
+
+lemma elems_eq_set: "elems xs = set xs"
+by (induction xs) auto
+
+lemma sorted_Cons_iff:
+ "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> elems xs. x < y))"
+by(simp add: elems_eq_set Sorted_Less.sorted_Cons_iff)
+
+lemma sorted_snoc_iff:
+ "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> elems xs. y < x))"
+by(simp add: elems_eq_set Sorted_Less.sorted_snoc_iff)
+
+lemma sorted_ConsD: "sorted (y # xs) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> y < x"
+by (simp add: sorted_Cons_iff)
+
+lemma sorted_snocD: "sorted (xs @ [y]) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> x < y"
+by (simp add: sorted_snoc_iff)
+
+lemmas elems_simps0 = sorted_lems elems_app
+lemmas elems_simps = elems_simps0 sorted_Cons_iff sorted_snoc_iff
+lemmas sortedD = sorted_ConsD sorted_snocD
+
+
+subsection \<open>Inserting into an ordered list without duplicates:\<close>
+
+fun ins_list :: "'a::linorder \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+"ins_list x [] = [x]" |
+"ins_list x (y#zs) =
+ (if x < y then x#y#zs else if x=y then x#zs else y # ins_list x zs)"
+
+lemma set_ins_list[simp]: "elems (ins_list x xs) = insert x (elems xs)"
+by(induction xs) auto
+
+lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
+apply(induction xs rule: sorted.induct)
+apply auto
+by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
+
+lemma sorted_ins_list: "sorted xs \<Longrightarrow> sorted(ins_list x xs)"
+by(induction xs rule: sorted.induct) auto
+
+lemma ins_list_sorted1: "sorted (xs @ [y]) \<Longrightarrow> y \<le> x \<Longrightarrow>
+ ins_list x (xs @ y # ys) = xs @ ins_list x (y#ys)"
+by(induction xs) (auto simp: sorted_lems)
+
+lemma ins_list_sorted2: "sorted (xs @ [y]) \<Longrightarrow> x < y \<Longrightarrow>
+ ins_list x (xs @ y # ys) = ins_list x xs @ (y#ys)"
+by(induction xs) (auto simp: sorted_lems)
+
+lemmas ins_simps = sorted_lems ins_list_sorted1 ins_list_sorted2
+
+
+subsection \<open>Delete one occurrence of an element from a list:\<close>
+
+fun del_list :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+"del_list a [] = []" |
+"del_list a (x#xs) = (if a=x then xs else x # del_list a xs)"
+
+lemma del_list_idem: "x \<notin> elems xs \<Longrightarrow> del_list x xs = xs"
+by (induct xs) simp_all
+
+lemma elems_del_list_eq [simp]:
+ "distinct xs \<Longrightarrow> elems (del_list x xs) = elems xs - {x}"
+apply(induct xs)
+ apply simp
+apply (simp add: elems_eq_set)
+apply blast
+done
+
+lemma sorted_del_list: "sorted xs \<Longrightarrow> sorted(del_list x xs)"
+apply(induction xs rule: sorted.induct)
+apply auto
+by (meson order.strict_trans sorted_Cons_iff)
+
+lemma del_list_sorted1: "sorted (xs @ [x]) \<Longrightarrow> x \<le> y \<Longrightarrow>
+ del_list y (xs @ x # ys) = xs @ del_list y (x # ys)"
+by (induction xs) (auto simp: sorted_mid_iff2)
+
+lemma del_list_sorted2: "sorted (xs @ x # ys) \<Longrightarrow> y < x \<Longrightarrow>
+ del_list y (xs @ x # ys) = del_list y xs @ x # ys"
+by (induction xs) (auto simp: sorted_Cons_iff intro!: del_list_idem)
+
+lemma del_list_sorted3:
+ "sorted (xs @ x # ys @ y # zs) \<Longrightarrow> a < y \<Longrightarrow>
+ del_list a (xs @ x # ys @ y # zs) = del_list a (xs @ x # ys) @ y # zs"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted2)
+
+lemma del_list_sorted4:
+ "sorted (xs @ x # ys @ y # zs @ z # us) \<Longrightarrow> a < z \<Longrightarrow>
+ del_list a (xs @ x # ys @ y # zs @ z # us) = del_list a (xs @ x # ys @ y # zs) @ z # us"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted3)
+
+lemma del_list_sorted5:
+ "sorted (xs @ x # ys @ y # zs @ z # us @ u # vs) \<Longrightarrow> a < u \<Longrightarrow>
+ del_list a (xs @ x # ys @ y # zs @ z # us @ u # vs) =
+ del_list a (xs @ x # ys @ y # zs @ z # us) @ u # vs"
+by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted4)
+
+lemmas del_simps = sorted_lems
+ del_list_sorted1
+ del_list_sorted2
+ del_list_sorted3
+ del_list_sorted4
+ del_list_sorted5
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Map_by_Ordered.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,55 @@
+(* Author: Tobias Nipkow *)
+
+section {* Implementing Ordered Maps *}
+
+theory Map_by_Ordered
+imports AList_Upd_Del
+begin
+
+locale Map =
+fixes empty :: "'m"
+fixes update :: "'a \<Rightarrow> 'b \<Rightarrow> 'm \<Rightarrow> 'm"
+fixes delete :: "'a \<Rightarrow> 'm \<Rightarrow> 'm"
+fixes map_of :: "'m \<Rightarrow> 'a \<Rightarrow> 'b option"
+fixes invar :: "'m \<Rightarrow> bool"
+assumes "map_of empty = (\<lambda>_. None)"
+assumes "invar m \<Longrightarrow> map_of(update a b m) = (map_of m)(a := Some b)"
+assumes "invar m \<Longrightarrow> map_of(delete a m) = (map_of m)(a := None)"
+assumes "invar m \<Longrightarrow> invar(update a b m)"
+assumes "invar m \<Longrightarrow> invar(delete a m)"
+
+locale Map_by_Ordered =
+fixes empty :: "'t"
+fixes update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> 't \<Rightarrow> 't"
+fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
+fixes lookup :: "'t \<Rightarrow> 'a \<Rightarrow> 'b option"
+fixes inorder :: "'t \<Rightarrow> ('a * 'b) list"
+fixes wf :: "'t \<Rightarrow> bool"
+assumes empty: "inorder empty = []"
+assumes lookup: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
+ lookup t a = map_of (inorder t) a"
+assumes update: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
+ inorder(update a b t) = upd_list a b (inorder t)"
+assumes delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
+ inorder(delete a t) = del_list a (inorder t)"
+assumes wf_insert: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(update a b t)"
+assumes wf_delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(delete a t)"
+begin
+
+sublocale Map
+ empty update delete "map_of o inorder" "\<lambda>t. wf t \<and> sorted1 (inorder t)"
+proof(standard, goal_cases)
+ case 1 show ?case by (auto simp: empty)
+next
+ case 2 thus ?case by(simp add: update map_of_ins_list)
+next
+ case 3 thus ?case by(simp add: delete map_of_del_list)
+next
+ case 4 thus ?case by(simp add: update wf_insert sorted_upd_list)
+next
+ case 5 thus ?case by (auto simp: delete wf_delete sorted_del_list)
+qed
+
+end
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Set_by_Ordered.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,60 @@
+(* Author: Tobias Nipkow *)
+
+section {* Implementing Ordered Sets *}
+
+theory Set_by_Ordered
+imports List_Ins_Del
+begin
+
+locale Set =
+fixes empty :: "'s"
+fixes insert :: "'a \<Rightarrow> 's \<Rightarrow> 's"
+fixes delete :: "'a \<Rightarrow> 's \<Rightarrow> 's"
+fixes isin :: "'s \<Rightarrow> 'a \<Rightarrow> bool"
+fixes set :: "'s \<Rightarrow> 'a set"
+fixes invar :: "'s \<Rightarrow> bool"
+assumes "set empty = {}"
+assumes "invar s \<Longrightarrow> isin s a = (a \<in> set s)"
+assumes "invar s \<Longrightarrow> set(insert a s) = Set.insert a (set s)"
+assumes "invar s \<Longrightarrow> set(delete a s) = set s - {a}"
+assumes "invar s \<Longrightarrow> invar(insert a s)"
+assumes "invar s \<Longrightarrow> invar(delete a s)"
+
+locale Set_by_Ordered =
+fixes empty :: "'t"
+fixes insert :: "'a::linorder \<Rightarrow> 't \<Rightarrow> 't"
+fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
+fixes isin :: "'t \<Rightarrow> 'a \<Rightarrow> bool"
+fixes inorder :: "'t \<Rightarrow> 'a list"
+fixes wf :: "'t \<Rightarrow> bool"
+assumes empty: "inorder empty = []"
+assumes isin: "wf t \<and> sorted(inorder t) \<Longrightarrow>
+ isin t a = (a \<in> elems (inorder t))"
+assumes insert: "wf t \<and> sorted(inorder t) \<Longrightarrow>
+ inorder(insert a t) = ins_list a (inorder t)"
+assumes delete: "wf t \<and> sorted(inorder t) \<Longrightarrow>
+ inorder(delete a t) = del_list a (inorder t)"
+assumes wf_insert: "wf t \<and> sorted(inorder t) \<Longrightarrow> wf(insert a t)"
+assumes wf_delete: "wf t \<and> sorted(inorder t) \<Longrightarrow> wf(delete a t)"
+begin
+
+sublocale Set
+ empty insert delete isin "elems o inorder" "\<lambda>t. wf t \<and> sorted(inorder t)"
+proof(standard, goal_cases)
+ case 1 show ?case by (auto simp: empty)
+next
+ case 2 thus ?case by(simp add: isin)
+next
+ case 3 thus ?case by(simp add: insert)
+next
+ case (4 s a) show ?case
+ using delete[OF 4, of a] 4 by (auto simp: distinct_if_sorted)
+next
+ case 5 thus ?case by(simp add: insert wf_insert sorted_ins_list)
+next
+ case 6 thus ?case by (auto simp: delete wf_delete sorted_del_list)
+qed
+
+end
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Sorted_Less.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,54 @@
+(* Author: Tobias Nipkow *)
+
+section {* Lists Sorted wrt $<$ *}
+
+theory Sorted_Less
+imports Less_False
+begin
+
+hide_const sorted
+
+text \<open>Is a list sorted without duplicates, i.e., wrt @{text"<"}?
+Could go into theory List under a name like @{term sorted_less}.\<close>
+
+fun sorted :: "'a::linorder list \<Rightarrow> bool" where
+"sorted [] = True" |
+"sorted [x] = True" |
+"sorted (x#y#zs) = (x < y \<and> sorted(y#zs))"
+
+lemma sorted_Cons_iff:
+ "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> set xs. x < y))"
+by(induction xs rule: sorted.induct) auto
+
+lemma sorted_snoc_iff:
+ "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> set xs. y < x))"
+by(induction xs rule: sorted.induct) auto
+
+lemma sorted_cons: "sorted (x#xs) \<Longrightarrow> sorted xs"
+by(simp add: sorted_Cons_iff)
+
+lemma sorted_cons': "ASSUMPTION (sorted (x#xs)) \<Longrightarrow> sorted xs"
+by(rule ASSUMPTION_D [THEN sorted_cons])
+
+lemma sorted_snoc: "sorted (xs @ [y]) \<Longrightarrow> sorted xs"
+by(simp add: sorted_snoc_iff)
+
+lemma sorted_snoc': "ASSUMPTION (sorted (xs @ [y])) \<Longrightarrow> sorted xs"
+by(rule ASSUMPTION_D [THEN sorted_snoc])
+
+lemma sorted_mid_iff:
+ "sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
+by(induction xs rule: sorted.induct) auto
+
+lemma sorted_mid_iff2:
+ "sorted(x # xs @ y # ys) =
+ (sorted(x # xs) \<and> x < y \<and> sorted(xs @ [y]) \<and> sorted(y # ys))"
+by(induction xs rule: sorted.induct) auto
+
+lemma sorted_mid_iff': "NO_MATCH [] ys \<Longrightarrow>
+ sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
+by(rule sorted_mid_iff)
+
+lemmas sorted_lems = sorted_mid_iff' sorted_mid_iff2 sorted_cons' sorted_snoc'
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Tree_Map.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,72 @@
+(* Author: Tobias Nipkow *)
+
+section {* Unbalanced Tree as Map *}
+
+theory Tree_Map
+imports
+ "~~/src/HOL/Library/Tree"
+ Map_by_Ordered
+begin
+
+fun lookup :: "('a::linorder*'b) tree \<Rightarrow> 'a \<Rightarrow> 'b option" where
+"lookup Leaf x = None" |
+"lookup (Node l (a,b) r) x = (if x < a then lookup l x else
+ if x > a then lookup r x else Some b)"
+
+fun update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
+"update a b Leaf = Node Leaf (a,b) Leaf" |
+"update a b (Node l (x,y) r) =
+ (if a < x then Node (update a b l) (x,y) r
+ else if a=x then Node l (a,b) r
+ else Node l (x,y) (update a b r))"
+
+fun del_min :: "'a tree \<Rightarrow> 'a * 'a tree" where
+"del_min (Node Leaf a r) = (a, r)" |
+"del_min (Node l a r) = (let (x,l') = del_min l in (x, Node l' a r))"
+
+fun delete :: "'a::linorder \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
+"delete k Leaf = Leaf" |
+"delete k (Node l (a,b) r) = (if k<a then Node (delete k l) (a,b) r else
+ if k > a then Node l (a,b) (delete k r) else
+ if r = Leaf then l else let (ab',r') = del_min r in Node l ab' r')"
+
+
+subsection "Functional Correctness Proofs"
+
+lemma lookup_eq: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
+apply (induction t)
+apply (auto simp: sorted_lems map_of_append map_of_sorteds split: option.split)
+done
+
+
+lemma inorder_update:
+ "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
+by(induction t) (auto simp: upd_list_sorteds sorted_lems)
+
+
+lemma del_minD:
+ "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted1(inorder t) \<Longrightarrow>
+ x # inorder t' = inorder t"
+by(induction t arbitrary: t' rule: del_min.induct)
+ (auto simp: sorted_lems split: prod.splits)
+
+lemma inorder_delete:
+ "sorted1(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
+by(induction t)
+ (auto simp: del_list_sorted sorted_lems dest!: del_minD split: prod.splits)
+
+
+interpretation Map_by_Ordered
+where empty = Leaf and lookup = lookup and update = update and delete = delete
+and inorder = inorder and wf = "\<lambda>_. True"
+proof (standard, goal_cases)
+ case 1 show ?case by simp
+next
+ case 2 thus ?case by(simp add: lookup_eq)
+next
+ case 3 thus ?case by(simp add: inorder_update)
+next
+ case 4 thus ?case by(simp add: inorder_delete)
+qed (rule TrueI)+
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/Tree_Set.thy Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,75 @@
+(* Author: Tobias Nipkow *)
+
+section {* Tree Implementation of Sets *}
+
+theory Tree_Set
+imports
+ "~~/src/HOL/Library/Tree"
+ Set_by_Ordered
+begin
+
+fun isin :: "'a::linorder tree \<Rightarrow> 'a \<Rightarrow> bool" where
+"isin Leaf x = False" |
+"isin (Node l a r) x = (x < a \<and> isin l x \<or> x=a \<or> isin r x)"
+
+hide_const (open) insert
+
+fun insert :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
+"insert a Leaf = Node Leaf a Leaf" |
+"insert a (Node l x r) =
+ (if a < x then Node (insert a l) x r
+ else if a=x then Node l x r
+ else Node l x (insert a r))"
+
+fun del_min :: "'a tree \<Rightarrow> 'a * 'a tree" where
+"del_min (Node Leaf a r) = (a, r)" |
+"del_min (Node l a r) = (let (x,l') = del_min l in (x, Node l' a r))"
+
+fun delete :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
+"delete k Leaf = Leaf" |
+"delete k (Node l a r) = (if k<a then Node (delete k l) a r else
+ if k > a then Node l a (delete k r) else
+ if r = Leaf then l else let (a',r') = del_min r in Node l a' r')"
+
+
+subsection "Functional Correctness Proofs"
+
+lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
+by (induction t) (auto simp: elems_simps)
+
+lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
+by (induction t) (auto simp: elems_simps0 dest: sortedD)
+
+
+lemma inorder_insert:
+ "sorted(inorder t) \<Longrightarrow> inorder(insert x t) = ins_list x (inorder t)"
+by(induction t) (auto simp: ins_simps)
+
+
+lemma del_minD:
+ "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted(inorder t) \<Longrightarrow>
+ x # inorder t' = inorder t"
+by(induction t arbitrary: t' rule: del_min.induct)
+ (auto simp: sorted_lems split: prod.splits)
+
+lemma inorder_delete:
+ "sorted(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
+by(induction t) (auto simp: del_simps del_minD split: prod.splits)
+
+
+interpretation Set_by_Ordered
+where empty = Leaf and isin = isin and insert = insert and delete = delete
+and inorder = inorder and wf = "\<lambda>_. True"
+proof (standard, goal_cases)
+ case 1 show ?case by simp
+next
+ case 2 thus ?case by(simp add: isin_set)
+next
+ case 3 thus ?case by(simp add: inorder_insert)
+next
+ case 4 thus ?case by(simp add: inorder_delete)
+next
+ case 5 thus ?case by(simp)
+qed
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/document/root.bib Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,20 @@
+@string{LNCS="Lect.\ Notes in Comp.\ Sci."}
+@string{MIT="MIT Press"}
+@string{Springer="Springer-Verlag"}
+
+@book{Nielson,author={Hanne Riis Nielson and Flemming Nielson},
+title={Semantics with Applications},publisher={Wiley},year=1992}
+
+@book{Winskel,author={Glynn Winskel},
+title={The Formal Semantics of Programming Languages},publisher=MIT,year=1993}
+
+@inproceedings{Nipkow,author={Tobias Nipkow},
+title={Winskel is (almost) Right: Towards a Mechanized Semantics Textbook},
+booktitle=
+{Foundations of Software Technology and Theoretical Computer Science},
+editor={V. Chandru and V. Vinay},
+publisher=Springer,series=LNCS,volume=1180,year=1996,pages={180--192}}
+
+@book{ConcreteSemantics,author={Tobias Nipkow and Gerwin Klein},
+title={Concrete Semantics. A Proof Assistant Approach},publisher=Springer,
+note={To appear}}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Data_Structures/document/root.tex Mon Sep 21 14:44:32 2015 +0200
@@ -0,0 +1,42 @@
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+\usepackage{latexsym}
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% snip
+\newcommand{\repeatisanl}[1]{\ifnum#1=0\else\isanewline\repeatisanl{\numexpr#1-1}\fi}
+\newcommand{\snip}[4]{\repeatisanl#2#4\repeatisanl#3}
+
+\urlstyle{rm}
+\isabellestyle{it}
+
+\renewcommand{\isacharunderscore}{\_}
+\renewcommand{\isacharunderscorekeyword}{\_}
+
+% for uniform font size
+\renewcommand{\isastyle}{\isastyleminor}
+
+\begin{document}
+
+\title{Functional Data Structures}
+\author{Tobias Nipkow}
+\maketitle
+
+\begin{abstract}
+A collection of verified functional data structures. The emphasis is on
+conciseness of algorithms and succinctness of proofs, more in the style
+of a textbook than a library of efficient algorithms.
+\end{abstract}
+
+\setcounter{tocdepth}{2}
+\tableofcontents
+\newpage
+
+% generated text of all theories
+\input{session}
+
+%\bibliographystyle{abbrv}
+%\bibliography{root}
+
+\end{document}
--- a/src/HOL/ROOT Mon Sep 21 11:31:56 2015 +0200
+++ b/src/HOL/ROOT Mon Sep 21 14:44:32 2015 +0200
@@ -169,6 +169,15 @@
options [document = false]
theories EvenOdd
+session "HOL-Data_Structures" in Data_Structures = HOL +
+ options [document_variants = document]
+ theories [document = false]
+ "Less_False"
+ theories
+ Tree_Set
+ Tree_Map
+ document_files "root.tex"
+
session "HOL-Import" in Import = HOL +
theories HOL_Light_Maps
theories [condition = HOL_LIGHT_BUNDLE] HOL_Light_Import