Commit d6aadd43 authored by Robbert Krebbers's avatar Robbert Krebbers

Generalize from_option and define default using it.

parent 618afceb
...@@ -765,7 +765,7 @@ Section option. ...@@ -765,7 +765,7 @@ Section option.
by exists (Some y'); split; [auto|apply cmra_validN_op_l with (core x)]. by exists (Some y'); split; [auto|apply cmra_validN_op_l with (core x)].
Qed. Qed.
Lemma option_updateP' (P : A Prop) x : Lemma option_updateP' (P : A Prop) x :
x ~~>: P Some x ~~>: λ my, default False my P. x ~~>: P Some x ~~>: from_option P False.
Proof. eauto using option_updateP. Qed. Proof. eauto using option_updateP. Qed.
Lemma option_update x y : x ~~> y Some x ~~> Some y. Lemma option_update x y : x ~~> y Some x ~~> Some y.
Proof. Proof.
......
...@@ -11,7 +11,7 @@ Module ra_reflection. Section ra_reflection. ...@@ -11,7 +11,7 @@ Module ra_reflection. Section ra_reflection.
| EOp : expr expr expr. | EOp : expr expr expr.
Fixpoint eval (Σ : list A) (e : expr) : A := Fixpoint eval (Σ : list A) (e : expr) : A :=
match e with match e with
| EVar n => from_option (Σ !! n) | EVar n => from_option id (Σ !! n)
| EEmpty => | EEmpty =>
| EOp e1 e2 => eval Σ e1 eval Σ e2 | EOp e1 e2 => eval Σ e1 eval Σ e2
end. end.
...@@ -22,7 +22,7 @@ Module ra_reflection. Section ra_reflection. ...@@ -22,7 +22,7 @@ Module ra_reflection. Section ra_reflection.
| EOp e1 e2 => flatten e1 ++ flatten e2 | EOp e1 e2 => flatten e1 ++ flatten e2
end. end.
Lemma eval_flatten Σ e : Lemma eval_flatten Σ e :
eval Σ e big_op ((λ n, from_option (Σ !! n)) <$> flatten e). eval Σ e big_op ((λ n, from_option id (Σ !! n)) <$> flatten e).
Proof. Proof.
by induction e as [| |e1 IH1 e2 IH2]; by induction e as [| |e1 IH1 e2 IH2];
rewrite /= ?right_id ?fmap_app ?big_op_app ?IH1 ?IH2. rewrite /= ?right_id ?fmap_app ?big_op_app ?IH1 ?IH2.
......
...@@ -542,7 +542,7 @@ Section option. ...@@ -542,7 +542,7 @@ Section option.
Proof. done. Qed. Proof. done. Qed.
Program Definition option_chain (c : chain (option A)) (x : A) : chain A := Program Definition option_chain (c : chain (option A)) (x : A) : chain A :=
{| chain_car n := from_option x (c n) |}. {| chain_car n := from_option id x (c n) |}.
Next Obligation. intros c x n i ?; simpl. by destruct (chain_cauchy c n i). Qed. Next Obligation. intros c x n i ?; simpl. by destruct (chain_cauchy c n i). Qed.
Instance option_compl : Compl (option A) := λ c, Instance option_compl : Compl (option A) := λ c,
match c 0 with Some x => Some (compl (option_chain c x)) | None => None end. match c 0 with Some x => Some (compl (option_chain c x)) | None => None end.
...@@ -569,9 +569,6 @@ Section option. ...@@ -569,9 +569,6 @@ Section option.
Proof. destruct 1; split; eauto. Qed. Proof. destruct 1; split; eauto. Qed.
Global Instance Some_dist_inj : Inj (dist n) (dist n) (@Some A). Global Instance Some_dist_inj : Inj (dist n) (dist n) (@Some A).
Proof. by inversion_clear 1. Qed. Proof. by inversion_clear 1. Qed.
Global Instance from_option_ne n :
Proper (dist n ==> dist n ==> dist n) (@from_option A).
Proof. by destruct 2. Qed.
Global Instance None_timeless : Timeless (@None A). Global Instance None_timeless : Timeless (@None A).
Proof. inversion_clear 1; constructor. Qed. Proof. inversion_clear 1; constructor. Qed.
...@@ -595,6 +592,11 @@ End option. ...@@ -595,6 +592,11 @@ End option.
Typeclasses Opaque option_dist. Typeclasses Opaque option_dist.
Arguments optionC : clear implicits. Arguments optionC : clear implicits.
Instance from_option_ne {A B : cofeT} (f : A B) n :
Proper (dist n ==> dist n) f
Proper (dist n ==> dist n ==> dist n) (from_option f).
Proof. destruct 3; simpl; auto. Qed.
Instance option_fmap_ne {A B : cofeT} (f : A B) n: Instance option_fmap_ne {A B : cofeT} (f : A B) n:
Proper (dist n ==> dist n) f Proper (dist n==>dist n) (fmap (M:=option) f). Proper (dist n ==> dist n) f Proper (dist n==>dist n) (fmap (M:=option) f).
Proof. by intros Hf; destruct 1; constructor; apply Hf. Qed. Proof. by intros Hf; destruct 1; constructor; apply Hf. Qed.
......
...@@ -270,7 +270,7 @@ Lemma singleton_updateP_empty `{Empty A, !CMRAUnit A} ...@@ -270,7 +270,7 @@ Lemma singleton_updateP_empty `{Empty A, !CMRAUnit A}
~~>: P ( y, P y Q {[ i := y ]}) ~~>: Q. ~~>: P ( y, P y Q {[ i := y ]}) ~~>: Q.
Proof. Proof.
intros Hx HQ n gf Hg. intros Hx HQ n gf Hg.
destruct (Hx n (from_option (gf !! i))) as (y&?&Hy). destruct (Hx n (from_option id (gf !! i))) as (y&?&Hy).
{ move:(Hg i). rewrite !left_id. { move:(Hg i). rewrite !left_id.
case _: (gf !! i); simpl; auto using cmra_unit_validN. } case _: (gf !! i); simpl; auto using cmra_unit_validN. }
exists {[ i := y ]}; split; first by auto. exists {[ i := y ]}; split; first by auto.
......
...@@ -43,7 +43,7 @@ Global Instance resize_ne n : ...@@ -43,7 +43,7 @@ Global Instance resize_ne n :
Program Definition list_chain Program Definition list_chain
(c : chain (list A)) (x : A) (k : nat) : chain A := (c : chain (list A)) (x : A) (k : nat) : chain A :=
{| chain_car n := from_option x (c n !! k) |}. {| chain_car n := from_option id x (c n !! k) |}.
Next Obligation. intros c x k n i ?. by rewrite /= (chain_cauchy c n i). Qed. Next Obligation. intros c x k n i ?. by rewrite /= (chain_cauchy c n i). Qed.
Instance list_compl : Compl (list A) := λ c, Instance list_compl : Compl (list A) := λ c,
match c 0 with match c 0 with
......
...@@ -1202,8 +1202,8 @@ Global Instance later_persistent P : PersistentP P → PersistentP (▷ P). ...@@ -1202,8 +1202,8 @@ Global Instance later_persistent P : PersistentP P → PersistentP (▷ P).
Proof. by intros; rewrite /PersistentP always_later; apply later_mono. Qed. Proof. by intros; rewrite /PersistentP always_later; apply later_mono. Qed.
Global Instance ownM_persistent : Persistent a PersistentP (@uPred_ownM M a). Global Instance ownM_persistent : Persistent a PersistentP (@uPred_ownM M a).
Proof. intros. by rewrite /PersistentP always_ownM. Qed. Proof. intros. by rewrite /PersistentP always_ownM. Qed.
Global Instance default_persistent {A} P (Ψ : A uPred M) (mx : option A) : Global Instance from_option_persistent {A} P (Ψ : A uPred M) (mx : option A) :
PersistentP P ( x, PersistentP (Ψ x)) PersistentP (default P mx Ψ). ( x, PersistentP (Ψ x)) PersistentP P PersistentP (from_option Ψ P mx).
Proof. destruct mx; apply _. Qed. Proof. destruct mx; apply _. Qed.
(* Derived lemmas for persistence *) (* Derived lemmas for persistence *)
......
...@@ -12,7 +12,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -12,7 +12,7 @@ Module uPred_reflection. Section uPred_reflection.
Fixpoint eval (Σ : list (uPred M)) (e : expr) : uPred M := Fixpoint eval (Σ : list (uPred M)) (e : expr) : uPred M :=
match e with match e with
| ETrue => True | ETrue => True
| EVar n => from_option True%I (Σ !! n) | EVar n => from_option id True%I (Σ !! n)
| ESep e1 e2 => eval Σ e1 eval Σ e2 | ESep e1 e2 => eval Σ e1 eval Σ e2
end. end.
Fixpoint flatten (e : expr) : list nat := Fixpoint flatten (e : expr) : list nat :=
...@@ -22,7 +22,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -22,7 +22,7 @@ Module uPred_reflection. Section uPred_reflection.
| ESep e1 e2 => flatten e1 ++ flatten e2 | ESep e1 e2 => flatten e1 ++ flatten e2
end. end.
Notation eval_list Σ l := ([] ((λ n, from_option True%I (Σ !! n)) <$> l))%I. Notation eval_list Σ l := ([] ((λ n, from_option id True%I (Σ !! n)) <$> l))%I.
Lemma eval_flatten Σ e : eval Σ e ⊣⊢ eval_list Σ (flatten e). Lemma eval_flatten Σ e : eval Σ e ⊣⊢ eval_list Σ (flatten e).
Proof. Proof.
induction e as [| |e1 IH1 e2 IH2]; induction e as [| |e1 IH1 e2 IH2];
......
...@@ -225,7 +225,7 @@ Fixpoint coPpick_raw (t : coPset_raw) : option positive := ...@@ -225,7 +225,7 @@ Fixpoint coPpick_raw (t : coPset_raw) : option positive :=
| Some i => Some (i~0) | None => (~1) <$> coPpick_raw r | Some i => Some (i~0) | None => (~1) <$> coPpick_raw r
end end
end. end.
Definition coPpick (X : coPset) : positive := from_option 1 (coPpick_raw (`X)). Definition coPpick (X : coPset) : positive := from_option id 1 (coPpick_raw (`X)).
Lemma coPpick_raw_elem_of t i : coPpick_raw t = Some i e_of i t. Lemma coPpick_raw_elem_of t i : coPpick_raw t = Some i e_of i t.
Proof. Proof.
......
...@@ -12,7 +12,7 @@ Arguments NoDup_enum _ {_ _} : clear implicits. ...@@ -12,7 +12,7 @@ Arguments NoDup_enum _ {_ _} : clear implicits.
Definition card A `{Finite A} := length (enum A). Definition card A `{Finite A} := length (enum A).
Program Instance finite_countable `{Finite A} : Countable A := {| Program Instance finite_countable `{Finite A} : Countable A := {|
encode := λ x, encode := λ x,
Pos.of_nat $ S $ from_option 0 $ fst <$> list_find (x =) (enum A); Pos.of_nat $ S $ from_option id 0 $ fst <$> list_find (x =) (enum A);
decode := λ p, enum A !! pred (Pos.to_nat p) decode := λ p, enum A !! pred (Pos.to_nat p)
|}. |}.
Arguments Pos.of_nat _ : simpl never. Arguments Pos.of_nat _ : simpl never.
...@@ -127,7 +127,7 @@ Lemma finite_surj A `{Finite A} B `{Finite B} : ...@@ -127,7 +127,7 @@ Lemma finite_surj A `{Finite A} B `{Finite B} :
0 < card A card B g : B A, Surj (=) g. 0 < card A card B g : B A, Surj (=) g.
Proof. Proof.
intros [??]. destruct (finite_inhabited A) as [x']; auto with lia. intros [??]. destruct (finite_inhabited A) as [x']; auto with lia.
exists (λ y : B, from_option x' (decode_nat (encode_nat y))). exists (λ y : B, from_option id x' (decode_nat (encode_nat y))).
intros x. destruct (encode_decode B (encode_nat x)) as (y&Hy1&Hy2). intros x. destruct (encode_decode B (encode_nat x)) as (y&Hy1&Hy2).
{ pose proof (encode_lt_card x); lia. } { pose proof (encode_lt_card x); lia. }
exists y. by rewrite Hy2, decode_encode_nat. exists y. by rewrite Hy2, decode_encode_nat.
......
...@@ -3393,7 +3393,7 @@ Definition eval {A} (E : env A) : rlist nat → list A := ...@@ -3393,7 +3393,7 @@ Definition eval {A} (E : env A) : rlist nat → list A :=
fix go t := fix go t :=
match t with match t with
| rnil => [] | rnil => []
| rnode i => from_option [] (E !! i) | rnode i => from_option id [] (E !! i)
| rapp t1 t2 => go t1 ++ go t2 | rapp t1 t2 => go t1 ++ go t2
end. end.
...@@ -3427,7 +3427,7 @@ End quote. ...@@ -3427,7 +3427,7 @@ End quote.
Section eval. Section eval.
Context {A} (E : env A). Context {A} (E : env A).
Lemma eval_alt t : eval E t = to_list t ≫= from_option [] ∘ (E !!). Lemma eval_alt t : eval E t = to_list t ≫= from_option id [] ∘ (E !!).
Proof. Proof.
induction t; csimpl. induction t; csimpl.
- done. - done.
......
...@@ -19,16 +19,15 @@ Proof. congruence. Qed. ...@@ -19,16 +19,15 @@ Proof. congruence. Qed.
Instance Some_inj {A} : Inj (=) (=) (@Some A). Instance Some_inj {A} : Inj (=) (=) (@Some A).
Proof. congruence. Qed. Proof. congruence. Qed.
(** The non dependent elimination principle on the option type. *) (** The [from_option] is the eliminator for option. *)
Definition default {A B} (y : B) (mx : option A) (f : A B) : B := Definition from_option {A B} (f : A B) (y : B) (mx : option A) : B :=
match mx with None => y | Some x => f x end. match mx with None => y | Some x => f x end.
Instance: Params (@default) 2. Instance: Params (@from_option) 3.
Arguments from_option {_ _} _ _ !_ /.
(** The [from_option] function allows us to get the value out of the option (* The eliminator again, but with the arguments in different order, which is
type by specifying a default value. *) sometimes more convenient. *)
Definition from_option {A} (x : A) (mx : option A) : A := Notation default y mx f := (from_option f y mx) (only parsing).
match mx with None => x | Some y => y end.
Instance: Params (@from_option) 1.
(** An alternative, but equivalent, definition of equality on the option (** An alternative, but equivalent, definition of equality on the option
data type. This theorem is useful to prove that two options are the same. *) data type. This theorem is useful to prove that two options are the same. *)
...@@ -137,9 +136,9 @@ Section setoids. ...@@ -137,9 +136,9 @@ Section setoids.
Global Instance is_Some_proper : Proper (() ==> iff) (@is_Some A). Global Instance is_Some_proper : Proper (() ==> iff) (@is_Some A).
Proof. inversion_clear 1; split; eauto. Qed. Proof. inversion_clear 1; split; eauto. Qed.
Global Instance from_option_proper : Global Instance from_option_proper {B} (R : relation B) (f : A B) :
Proper (() ==> () ==> ()) (@from_option A). Proper (() ==> R) f Proper (R ==> () ==> R) (from_option f).
Proof. by destruct 2. Qed. Proof. destruct 3; simpl; auto. Qed.
End setoids. End setoids.
Typeclasses Opaque option_equiv. Typeclasses Opaque option_equiv.
...@@ -323,9 +322,7 @@ Tactic Notation "simpl_option" "by" tactic3(tac) := ...@@ -323,9 +322,7 @@ Tactic Notation "simpl_option" "by" tactic3(tac) :=
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx
| H : context [fmap (M:=option) (A:=?A) ?f ?mx] |- _ => | H : context [fmap (M:=option) (A:=?A) ?f ?mx] |- _ =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx
| H : context [default (A:=?A) _ ?mx _] |- _ => | H : context [from_option (A:=?A) _ _ ?mx] |- _ =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx
| H : context [from_option (A:=?A) _ ?mx] |- _ =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx
| H : context [ match ?mx with _ => _ end ] |- _ => | H : context [ match ?mx with _ => _ end ] |- _ =>
match type of mx with match type of mx with
...@@ -336,9 +333,7 @@ Tactic Notation "simpl_option" "by" tactic3(tac) := ...@@ -336,9 +333,7 @@ Tactic Notation "simpl_option" "by" tactic3(tac) :=
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx
| |- context [fmap (M:=option) (A:=?A) ?f ?mx] => | |- context [fmap (M:=option) (A:=?A) ?f ?mx] =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx
| |- context [default (A:=?A) _ ?mx _] => | |- context [from_option (A:=?A) _ _ ?mx] =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx
| |- context [from_option (A:=?A) _ ?mx] =>
let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx
| |- context [ match ?mx with _ => _ end ] => | |- context [ match ?mx with _ => _ end ] =>
match type of mx with match type of mx with
......
...@@ -752,7 +752,7 @@ Qed. ...@@ -752,7 +752,7 @@ Qed.
(** The [option] is to account for formulas that can be framed entirely, so (** The [option] is to account for formulas that can be framed entirely, so
we do not end up with [True]s everywhere. *) we do not end up with [True]s everywhere. *)
Class Frame (R P : uPred M) (mQ : option (uPred M)) := Class Frame (R P : uPred M) (mQ : option (uPred M)) :=
frame : (R from_option True mQ) P. frame : (R from_option id True mQ) P.
Arguments frame : clear implicits. Arguments frame : clear implicits.
Global Instance frame_here R : Frame R R None. Global Instance frame_here R : Frame R R None.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment