header {* Canonical order on option type *}
theory Option_ord
imports Option Main
begin
instantiation option :: (preorder) preorder
begin
definition less_eq_option where
[code del]: "x ≤ y <-> (case x of None => True | Some x => (case y of None => False | Some y => x ≤ y))"
definition less_option where
[code del]: "x < y <-> (case y of None => False | Some y => (case x of None => True | Some x => x < y))"
lemma less_eq_option_None [simp]: "None ≤ x"
by (simp add: less_eq_option_def)
lemma less_eq_option_None_code [code]: "None ≤ x <-> True"
by simp
lemma less_eq_option_None_is_None: "x ≤ None ==> x = None"
by (cases x) (simp_all add: less_eq_option_def)
lemma less_eq_option_Some_None [simp, code]: "Some x ≤ None <-> False"
by (simp add: less_eq_option_def)
lemma less_eq_option_Some [simp, code]: "Some x ≤ Some y <-> x ≤ y"
by (simp add: less_eq_option_def)
lemma less_option_None [simp, code]: "x < None <-> False"
by (simp add: less_option_def)
lemma less_option_None_is_Some: "None < x ==> ∃z. x = Some z"
by (cases x) (simp_all add: less_option_def)
lemma less_option_None_Some [simp]: "None < Some x"
by (simp add: less_option_def)
lemma less_option_None_Some_code [code]: "None < Some x <-> True"
by simp
lemma less_option_Some [simp, code]: "Some x < Some y <-> x < y"
by (simp add: less_option_def)
instance proof
qed (auto simp add: less_eq_option_def less_option_def less_le_not_le elim: order_trans split: option.splits)
end
instance option :: (order) order proof
qed (auto simp add: less_eq_option_def less_option_def split: option.splits)
instance option :: (linorder) linorder proof
qed (auto simp add: less_eq_option_def less_option_def split: option.splits)
instantiation option :: (preorder) bot
begin
definition "bot = None"
instance proof
qed (simp add: bot_option_def)
end
instantiation option :: (top) top
begin
definition "top = Some top"
instance proof
qed (simp add: top_option_def less_eq_option_def split: option.split)
end
instance option :: (wellorder) wellorder proof
fix P :: "'a option => bool" and z :: "'a option"
assume H: "!!x. (!!y. y < x ==> P y) ==> P x"
have "P None" by (rule H) simp
then have P_Some [case_names Some]:
"!!z. (!!x. z = Some x ==> (P o Some) x) ==> P z"
proof -
fix z
assume "!!x. z = Some x ==> (P o Some) x"
with `P None` show "P z" by (cases z) simp_all
qed
show "P z" proof (cases z rule: P_Some)
case (Some w)
show "(P o Some) w" proof (induct rule: less_induct)
case (less x)
have "P (Some x)" proof (rule H)
fix y :: "'a option"
assume "y < Some x"
show "P y" proof (cases y rule: P_Some)
case (Some v) with `y < Some x` have "v < x" by simp
with less show "(P o Some) v" .
qed
qed
then show ?case by simp
qed
qed
qed
end