Theory Table

(*  Title:      HOL/Bali/Table.thy
Author:     David von Oheimb
*)
subsection ‹Abstract tables and their implementation as lists›

theory Table imports Basis begin

text ‹
design issues:
\begin{itemize}
\item definition of table: infinite map vs. list vs. finite set
list chosen, because:
\begin{itemize}
\item[+]  a priori finite
\item[+]  lookup is more operational than for finite set
\item[-]  not very abstract, but function table converts it to abstract
mapping
\end{itemize}
\item coding of lookup result: Some/None vs. value/arbitrary
Some/None chosen, because:
\begin{itemize}
\item[++] makes definedness check possible (applies also to finite set),
which is important for the type standard, hiding/overriding, etc.
(though it may perhaps be possible at least for the operational semantics
to treat programs as infinite, i.e. where classes, fields, methods etc.
of any name are considered to be defined)
\item[-]  sometimes awkward case distinctions, alleviated by operator 'the'
\end{itemize}
\end{itemize}
›

type_synonym ('a, 'b) table    ― ‹table with key type 'a and contents type 'b›
= "'a ⇀ 'b"
type_synonym ('a, 'b) tables   ― ‹non-unique table with key 'a and contents 'b›
= "'a ⇒ 'b set"

subsubsection "map of / table of"

abbreviation
table_of :: "('a × 'b) list ⇒ ('a, 'b) table"   ― ‹concrete table›
where "table_of ≡ map_of"

translations
(type) "('a, 'b) table" <= (type) "'a ⇀ 'b"

(* ### To map *)
lemma map_add_find_left[simp]: "n k = None ⟹ (m ++ n) k = m k"

subsubsection ‹Conditional Override›

definition cond_override :: "('b ⇒'b ⇒ bool) ⇒ ('a, 'b)table ⇒ ('a, 'b)table ⇒ ('a, 'b) table" where

― ‹when merging tables old and new, only override an entry of table old when
the condition cond holds›
"cond_override cond old new =
(λk.
(case new k of
None         ⇒ old k
| Some new_val ⇒ (case old k of
None         ⇒ Some new_val
| Some old_val ⇒ (if cond new_val old_val
then Some new_val
else Some old_val))))"

lemma cond_override_empty1[simp]: "cond_override c Map.empty t = t"

lemma cond_override_empty2[simp]: "cond_override c t Map.empty = t"

lemma cond_override_None[simp]:
"old k = None ⟹ (cond_override c old new) k = new k"

lemma cond_override_override:
"⟦old k = Some ov;new k = Some nv; C nv ov⟧
⟹ (cond_override C old new) k = Some nv"

lemma cond_override_noOverride:
"⟦old k = Some ov;new k = Some nv; ¬ (C nv ov)⟧
⟹ (cond_override C old new) k = Some ov"

lemma dom_cond_override: "dom (cond_override C s t) ⊆ dom s ∪ dom t"
by (auto simp add: cond_override_def dom_def)

lemma finite_dom_cond_override:
"⟦ finite (dom s); finite (dom t) ⟧ ⟹ finite (dom (cond_override C s t))"
apply (rule_tac B="dom s ∪ dom t" in finite_subset)
apply (rule dom_cond_override)
by (rule finite_UnI)

subsubsection ‹Filter on Tables›

definition filter_tab :: "('a ⇒ 'b ⇒ bool) ⇒ ('a, 'b) table ⇒ ('a, 'b) table"
where
"filter_tab c t = (λk. (case t k of
None   ⇒ None
| Some x ⇒ if c k x then Some x else None))"

lemma filter_tab_empty[simp]: "filter_tab c Map.empty = Map.empty"

lemma filter_tab_True[simp]: "filter_tab (λx y. True) t = t"

lemma filter_tab_False[simp]: "filter_tab (λx y. False) t = Map.empty"
by (simp add: fun_eq_iff filter_tab_def empty_def)

lemma filter_tab_ran_subset: "ran (filter_tab c t) ⊆ ran t"
by (auto simp add: filter_tab_def ran_def)

lemma filter_tab_range_subset: "range (filter_tab c t) ⊆ range t ∪ {None}"
apply (drule sym, blast)
done

lemma finite_range_filter_tab:
"finite (range t) ⟹ finite (range (filter_tab c t))"
apply (rule_tac B="range t ∪ {None} " in finite_subset)
apply (rule filter_tab_range_subset)
apply (auto intro: finite_UnI)
done

lemma filter_tab_SomeD[dest!]:
"filter_tab c t k = Some x ⟹ (t k = Some x) ∧ c k x"

lemma filter_tab_SomeI: "⟦t k = Some x;C k x⟧ ⟹filter_tab C t k = Some x"

lemma filter_tab_all_True:
"∀ k y. t k = Some y ⟶ p k y ⟹filter_tab p t = t"
apply (auto simp add: filter_tab_def fun_eq_iff)
done

lemma filter_tab_all_True_Some:
"⟦∀ k y. t k = Some y ⟶ p k y; t k = Some v⟧ ⟹ filter_tab p t k = Some v"
by (auto simp add: filter_tab_def fun_eq_iff)

lemma filter_tab_all_False:
"∀ k y. t k = Some y ⟶ ¬ p k y ⟹filter_tab p t = Map.empty"
by (auto simp add: filter_tab_def fun_eq_iff)

lemma filter_tab_None: "t k = None ⟹ filter_tab p t k = None"
done

lemma filter_tab_dom_subset: "dom (filter_tab C t) ⊆ dom t"
by (auto simp add: filter_tab_def dom_def)

lemma filter_tab_eq: "⟦a=b⟧ ⟹ filter_tab C a = filter_tab C b"
by (auto simp add: fun_eq_iff filter_tab_def)

lemma finite_dom_filter_tab:
"finite (dom t) ⟹ finite (dom (filter_tab C t))"
apply (rule_tac B="dom t" in finite_subset)
by (rule filter_tab_dom_subset)

lemma filter_tab_weaken:
"⟦∀ a ∈ t k: ∃ b ∈ s k: P a b;
⋀ k x y. ⟦t k = Some x;s k = Some y⟧ ⟹ cond k x ⟶ cond k y
⟧ ⟹ ∀ a ∈ filter_tab cond t k: ∃ b ∈ filter_tab cond s k: P a b"

lemma cond_override_filter:
"⟦⋀ k old new. ⟦s k = Some new; t k = Some old⟧
⟹ (¬ overC new old ⟶  ¬ filterC k new) ∧
(overC new old ⟶ filterC k old ⟶ filterC k new)
⟧ ⟹
cond_override overC (filter_tab filterC t) (filter_tab filterC s)
= filter_tab filterC (cond_override overC t s)"
by (auto simp add: fun_eq_iff cond_override_def filter_tab_def )

subsubsection ‹Misc›

lemma Ball_set_table: "(∀ (x,y)∈ set l. P x y) ⟹ ∀ x. ∀ y∈ map_of l x: P x y"
apply (erule rev_mp)
apply (induct l)
apply simp
apply (simp (no_asm))
apply auto
done

lemma Ball_set_tableD:
"⟦(∀ (x,y)∈ set l. P x y); x ∈ set_option (table_of l xa)⟧ ⟹ P xa x"
apply (frule Ball_set_table)
by auto

declare map_of_SomeD [elim]

lemma table_of_Some_in_set:
"table_of l k = Some x ⟹ (k,x) ∈ set l"
by auto

lemma set_get_eq:
"unique l ⟹ (k, the (table_of l k)) ∈ set l = (table_of l k ≠ None)"
by (auto dest!: weak_map_of_SomeI)

lemma inj_Pair_const2: "inj (λk. (k, C))"
apply (rule inj_onI)
apply auto
done

lemma table_of_mapconst_SomeI:
"⟦table_of t k = Some y'; snd y=y'; fst y=c⟧ ⟹
table_of (map (λ(k,x). (k,c,x)) t) k = Some y"
by (induct t) auto

lemma table_of_mapconst_NoneI:
"⟦table_of t k = None⟧ ⟹
table_of (map (λ(k,x). (k,c,x)) t) k = None"
by (induct t) auto

lemmas table_of_map2_SomeI = inj_Pair_const2 [THEN map_of_mapk_SomeI]

lemma table_of_map_SomeI: "table_of t k = Some x ⟹
table_of (map (λ(k,x). (k, f x)) t) k = Some (f x)"
by (induct t) auto

lemma table_of_remap_SomeD:
"table_of (map (λ((k,k'),x). (k,(k',x))) t) k = Some (k',x) ⟹
table_of t (k, k') = Some x"
by (induct t) auto

lemma table_of_mapf_Some:
"∀x y. f x = f y ⟶ x = y ⟹
table_of (map (λ(k,x). (k,f x)) t) k = Some (f x) ⟹ table_of t k = Some x"
by (induct t) auto

lemma table_of_mapf_SomeD [dest!]:
"table_of (map (λ(k,x). (k, f x)) t) k = Some z ⟹ (∃y∈table_of t k: z=f y)"
by (induct t) auto

lemma table_of_mapf_NoneD [dest!]:
"table_of (map (λ(k,x). (k, f x)) t) k = None ⟹ (table_of t k = None)"
by (induct t) auto

lemma table_of_mapkey_SomeD [dest!]:
"table_of (map (λ(k,x). ((k,C),x)) t) (k,D) = Some x ⟹ C = D ∧ table_of t k = Some x"
by (induct t) auto

lemma table_of_mapkey_SomeD2 [dest!]:
"table_of (map (λ(k,x). ((k,C),x)) t) ek = Some x ⟹
C = snd ek ∧ table_of t (fst ek) = Some x"
by (induct t) auto

lemma table_append_Some_iff: "table_of (xs@ys) k = Some z =
(table_of xs k = Some z ∨ (table_of xs k = None ∧ table_of ys k = Some z))"
apply (simp)
done

lemma table_of_filter_unique_SomeD [rule_format (no_asm)]:
"table_of (filter P xs) k = Some z ⟹ unique xs ⟶ table_of xs k = Some z"
by (induct xs) (auto del: map_of_SomeD intro!: map_of_SomeD)

definition Un_tables :: "('a, 'b) tables set ⇒ ('a, 'b) tables"
where "Un_tables ts = (λk. ⋃t∈ts. t k)"

definition overrides_t :: "('a, 'b) tables ⇒ ('a, 'b) tables ⇒ ('a, 'b) tables"
(infixl "⊕⊕" 100)
where "s ⊕⊕ t = (λk. if t k = {} then s k else t k)"

definition
hidings_entails :: "('a, 'b) tables ⇒ ('a, 'c) tables ⇒ ('b ⇒ 'c ⇒ bool) ⇒ bool"
("_ hidings _ entails _" 20)
where "(t hidings s entails R) = (∀k. ∀x∈t k. ∀y∈s k. R x y)"

definition
― ‹variant for unique table:›
hiding_entails :: "('a, 'b) table  ⇒ ('a, 'c) table  ⇒ ('b ⇒ 'c ⇒ bool) ⇒ bool"
("_ hiding _ entails _"  20)
where "(t hiding  s entails R) = (∀k. ∀x∈t k: ∀y∈s k: R x y)"

definition
― ‹variant for a unique table and conditional overriding:›
cond_hiding_entails :: "('a, 'b) table  ⇒ ('a, 'c) table
⇒ ('b ⇒ 'c ⇒ bool) ⇒ ('b ⇒ 'c ⇒ bool) ⇒ bool"
("_ hiding _ under _ entails _"  20)
where "(t hiding  s under C entails R) = (∀k. ∀x∈t k: ∀y∈s k: C x y ⟶ R x y)"

subsubsection "Untables"

lemma Un_tablesI [intro]:  "t ∈ ts ⟹ x ∈ t k ⟹ x ∈ Un_tables ts k"

lemma Un_tablesD [dest!]: "x ∈ Un_tables ts k ⟹ ∃t. t ∈ ts ∧ x ∈ t k"

lemma Un_tables_empty [simp]: "Un_tables {} = (λk. {})"

subsubsection "overrides"

lemma empty_overrides_t [simp]: "(λk. {}) ⊕⊕ m = m"

lemma overrides_empty_t [simp]: "m ⊕⊕ (λk. {}) = m"

lemma overrides_t_Some_iff:
"(x ∈ (s ⊕⊕ t) k) = (x ∈ t k ∨ t k = {} ∧ x ∈ s k)"

lemmas overrides_t_SomeD = overrides_t_Some_iff [THEN iffD1, dest!]

lemma overrides_t_right_empty [simp]: "n k = {} ⟹ (m ⊕⊕ n) k = m k"

lemma overrides_t_find_right [simp]: "n k ≠ {} ⟹ (m ⊕⊕ n) k = n k"

subsubsection "hiding entails"

lemma hiding_entailsD:
"t hiding s entails R ⟹ t k = Some x ⟹ s k = Some y ⟹ R x y"

lemma empty_hiding_entails [simp]: "Map.empty hiding s entails R"

lemma hiding_empty_entails [simp]: "t hiding Map.empty entails R"

subsubsection "cond hiding entails"

lemma cond_hiding_entailsD:
"⟦t hiding s under C entails R; t k = Some x; s k = Some y; C x y⟧ ⟹ R x y"

lemma empty_cond_hiding_entails[simp]: "Map.empty hiding s under C entails R"

lemma cond_hiding_empty_entails[simp]: "t hiding Map.empty under C entails R"

lemma hidings_entailsD: "⟦t hidings s entails R; x ∈ t k; y ∈ s k⟧ ⟹ R x y"

lemma hidings_empty_entails [intro!]: "t hidings (λk. {}) entails R"
apply (unfold hidings_entails_def)
apply (simp (no_asm))
done

lemma empty_hidings_entails [intro!]:
"(λk. {}) hidings s entails R"apply (unfold hidings_entails_def)
by (simp (no_asm))

(*###TO Map?*)
primrec atleast_free :: "('a ⇀ 'b) => nat => bool"
where
"atleast_free m 0 = True"
| atleast_free_Suc: "atleast_free m (Suc n) = (∃a. m a = None ∧ (∀b. atleast_free (m(a↦b)) n))"

lemma atleast_free_weaken [rule_format (no_asm)]:
"∀m. atleast_free m (Suc n) ⟶ atleast_free m n"
apply (induct_tac "n")
apply (simp (no_asm))
apply clarify
apply (simp (no_asm))
apply (drule atleast_free_Suc [THEN iffD1])
apply fast
done

lemma atleast_free_SucI:
"[| h a = None; ∀obj. atleast_free (h(a|->obj)) n |] ==> atleast_free h (Suc n)"
by force

declare fun_upd_apply [simp del]
lemma atleast_free_SucD_lemma [rule_format (no_asm)]:
"∀m a. m a = None ⟶ (∀c. atleast_free (m(a↦c)) n) ⟶
(∀b d. a ≠ b ⟶ atleast_free (m(b↦d)) n)"
apply (induct_tac "n")
apply  auto
apply (rule_tac x = "a" in exI)
apply  (rule conjI)
apply (erule_tac V = "m a = None" in thin_rl)
apply clarify
apply (subst fun_upd_twist)
apply  (erule not_sym)
apply (rename_tac "ba")
apply (drule_tac x = "ba" in spec)
apply clarify
apply (tactic "smp_tac \<^context> 2 1")
apply (erule (1) notE impE)
apply (case_tac "aa = b")
apply fast+
done
declare fun_upd_apply [simp]

lemma atleast_free_SucD: "atleast_free h (Suc n) ==> atleast_free (h(a|->b)) n"
apply auto
apply (case_tac "aa = a")
apply auto
apply (erule atleast_free_SucD_lemma)
apply auto
done

declare atleast_free_Suc [simp del]

end