Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Hide interface definitions #116

Merged
merged 1 commit into from
Jul 26, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions example_typed_store.v
Original file line number Diff line number Diff line change
Expand Up @@ -546,7 +546,7 @@
End fact_for_int63.

Section eval.
Require Import typed_store_model.

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.16.0-coq-8.16)

Use of “Require” inside a section is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.16.0-coq-8.16)

Use of “Require” inside a module is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.16.0-coq-8.17)

Use of “Require” inside a section is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.16.0-coq-8.17)

Use of “Require” inside a module is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.17.0-coq-8.16)

Use of “Require” inside a section is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.17.0-coq-8.16)

Use of “Require” inside a module is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.17.0-coq-8.17)

Use of “Require” inside a section is fragile. It is not recommended

Check warning on line 549 in example_typed_store.v

View workflow job for this annotation

GitHub Actions / build (mathcomp/mathcomp:1.17.0-coq-8.17)

Use of “Require” inside a module is fragile. It is not recommended

Definition M := [the typedStoreMonad ml_type monad_model.locT_nat of
acto ml_type].
Expand All @@ -563,6 +563,7 @@
do x <- cget l; do _ <- cput l (Uint63.succ x); Ret (Uint63.succ x).

Definition l : W (loc ml_int) := Restart it0 (cnew ml_int 3)%int63.
Eval vm_compute in l.

Definition it1 := Restart l (do l <- FromW l; incr l).
Eval vm_compute in it1.
Expand Down
36 changes: 18 additions & 18 deletions monad_model.v
Original file line number Diff line number Diff line change
Expand Up @@ -1692,17 +1692,17 @@ Local Notation nth_error := List.nth_error.

Notation loc := (@loc ml_type locT_nat).

Definition cnew T (v : coq_type M T) : M (loc T) :=
Let cnew T (v : coq_type M T) : M (loc T) :=
fun st => let n := size st in
Ret (mkloc T n, rcons st (mkbind T (v : coq_type' T))).

Definition cget T (r : loc T) : M (coq_type M T) :=
Let cget T (r : loc T) : M (coq_type M T) :=
fun st =>
if nth_error st (loc_id r) is Some (mkbind T' v) then
if coerce T v is Some u then Ret (u, st) else fail
else fail.

Definition cput T (r : loc T) (v : coq_type M T) : M unit :=
Let cput T (r : loc T) (v : coq_type M T) : M unit :=
fun st =>
let n := loc_id r in
if nth_error st n is Some (mkbind T' _) then
Expand All @@ -1711,7 +1711,7 @@ Definition cput T (r : loc T) (v : coq_type M T) : M unit :=
else fail
else fail.

Definition crun (A : UU0) (m : M A) : option A :=
Let crun (A : UU0) (m : M A) : option A :=
match m nil with
| inl _ => None
| inr (a, _) => Some a
Expand Down Expand Up @@ -1755,14 +1755,14 @@ Lemma Some_cget T (r : loc T) (s : coq_type M T) e (A : UU0) (f : coq_type M T -
Proof. by move=> H; rewrite MS_bindE /cget H coerce_Some. Qed.
Arguments Some_cget {T r} s.

Lemma cnewget T (s : coq_type M T) A (k : loc T -> coq_type M T -> M A) :
Let cnewget T (s : coq_type M T) A (k : loc T -> coq_type M T -> M A) :
cnew s >>= (fun r => cget r >>= k r) = cnew s >>= (fun r => k r s).
Proof.
apply/boolp.funext => e.
by rewrite bind_cnew (Some_cget s)// nth_error_rcons_size.
Qed.

Lemma cnewput T (s t : coq_type M T) A (k : loc T -> M A) :
Let cnewput T (s t : coq_type M T) A (k : loc T -> M A) :
cnew s >>= (fun r => cput r t >> k r) = cnew t >>= k.
Proof.
apply/boolp.funext => e.
Expand Down Expand Up @@ -1812,7 +1812,7 @@ Proof.
by move=> H; rewrite /cput/= H coerce_Some/= nth_error_set_nth_id.
Qed.

Lemma cgetputskip T (r : loc T) : cget r >>= cput r = cget r >> skip.
Let cgetputskip T (r : loc T) : cget r >>= cput r = cget r >> skip.
Proof.
apply/boolp.funext => e /=.
have [s' H|T' s' H Ts'|H] := ntherrorP e r.
Expand All @@ -1821,7 +1821,7 @@ have [s' H|T' s' H Ts'|H] := ntherrorP e r.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cgetget T (r : loc T) (A : UU0)
Let cgetget T (r : loc T) (A : UU0)
(k : coq_type M T -> coq_type M T -> M A) :
cget r >>= (fun s => cget r >>= k s) = cget r >>= fun s => k s s.
Proof.
Expand All @@ -1848,7 +1848,7 @@ by rewrite bindE/= (Some_cget s)// nth_error_set_nth.
Qed.
Arguments Some_cputget {T} s'.

Lemma cputget T (r : loc T) (s : coq_type M T) (A : UU0)
Let cputget T (r : loc T) (s : coq_type M T) (A : UU0)
(k : coq_type M T -> M A) :
cput r s >> (cget r >>= k) = cput r s >> k s.
Proof.
Expand All @@ -1873,7 +1873,7 @@ rewrite nth_error_set_nth coerce_Some/=.
by rewrite set_set_nth eqxx.
Qed.

Lemma cputput T (r : loc T) (s s' : coq_type M T) :
Let cputput T (r : loc T) (s s' : coq_type M T) :
cput r s >> cput r s' = cput r s'.
Proof.
apply/boolp.funext => e.
Expand All @@ -1883,7 +1883,7 @@ have [s'' H|T'' s'' H Ts''|H] := ntherrorP e r.
- by rewrite MS_bindE !None_cput.
Qed.

Lemma cgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (A : UU0)
Let cgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (A : UU0)
(k : coq_type M T1 -> coq_type M T2 -> M A) :
cget r1 >>= (fun u => cget r2 >>= (fun v => k u v)) =
cget r2 >>= (fun v => cget r1 >>= (fun u => k u v)).
Expand All @@ -1908,7 +1908,7 @@ have [u Hr1|u T1' Hr1 T1u|Hr1] := ntherrorP e r1.
Qed.

(* NB: this is similar to the cnewget law *)
Lemma cnewgetD_helper e T T' r v (s : coq_type M T') A (k : loc T' -> coq_type M T -> M A) :
Let cnewgetD_helper e T T' r v (s : coq_type M T') A (k : loc T' -> coq_type M T -> M A) :
nth_error e (loc_id r) = Some (mkbind T v) ->
(cnew s >>= (fun r' => cget r >>= k r')) e = (cnew s >>= (fun r => k r v)) e.
Proof.
Expand All @@ -1917,7 +1917,7 @@ rewrite bind_cnew//.
by rewrite (Some_cget v) // (nth_error_rcons_some _ H).
Qed.

Lemma cgetnewD T T' (r : loc T) (s : coq_type M T') A
Let cgetnewD T T' (r : loc T) (s : coq_type M T') A
(k : loc T' -> coq_type M T -> coq_type M T -> M A) :
cget r >>= (fun u => cnew s >>= fun r' => cget r >>= k r' u) =
cget r >>= (fun u => cnew s >>= fun r' => k r' u u).
Expand All @@ -1929,7 +1929,7 @@ have [u Hr|u T1 Hr T1u|Hr] := ntherrorP e r.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cgetnewE T1 T2 (r1 : loc T1) (s : coq_type M T2) (A : UU0)
Let cgetnewE T1 T2 (r1 : loc T1) (s : coq_type M T2) (A : UU0)
(k1 k2 : loc T2 -> M A) :
(forall r2 : loc T2, loc_id r1 != loc_id r2 -> k1 r2 = k2 r2) ->
cget r1 >> (cnew s >>= k1) = cget r1 >> (cnew s >>= k2).
Expand All @@ -1943,7 +1943,7 @@ have [u r1u|T' s' Hr1 T1s'|Hr] := ntherrorP e r1.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cgetputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s : coq_type M T2) :
Let cgetputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s : coq_type M T2) :
cget r1 >> cput r2 s = cput r2 s >> cget r1 >> skip.
Proof.
apply/boolp.funext => e /=.
Expand Down Expand Up @@ -2008,7 +2008,7 @@ have [v Hr2|T2' v Hr2 T2v|Hr2] := ntherrorP e r2; last first.
by rewrite (@nth_error_set_nth_other _ _ _ _ _ (mkbind T1' s1')).
Qed.

Lemma cputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type M T1)
Let cputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type M T1)
(s2 : coq_type M T2) (A : UU0) :
loc_id r1 != loc_id r2 \/ JMeq s1 s2 ->
cput r1 s1 >> cput r2 s2 = cput r2 s2 >> cput r1 s1.
Expand Down Expand Up @@ -2057,7 +2057,7 @@ have [u Hr1|T1' s'd Hr1 T1s'|Hr1] := ntherrorP e r1; last first.
by rewrite set_set_nth (negbTE Hr).
Qed.

Lemma cputgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type M T1)
Let cputgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type M T1)
(A : UU0) (k : coq_type M T2 -> M A) :
loc_id r1 != loc_id r2 ->
cput r1 s1 >> cget r2 >>= k = cget r2 >>= (fun v => cput r1 s1 >> k v).
Expand Down Expand Up @@ -2088,7 +2088,7 @@ have [u Hr1|T1' s1' Hr1 T1s'|Hr1] := ntherrorP e r1.
+ by rewrite None_cget.
Qed.

Lemma cputnewC T T' (r : loc T) (s : coq_type M T) (s' : coq_type M T') A
Let cputnewC T T' (r : loc T) (s : coq_type M T) (s' : coq_type M T') A
(k : loc T' -> M A) :
cget r >> (cnew s' >>= fun r' => cput r s >> k r') =
cput r s >> (cnew s' >>= k).
Expand Down
42 changes: 21 additions & 21 deletions typed_store_model.v
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,7 @@ Lemma None_cget T (r : loc T) e :
Proof. by move=> H; rewrite /cget H. Qed.

(* Prove the laws *)
Lemma cnewget T (s : coq_type T) A (k : loc T -> coq_type T -> M A) :
Let cnewget T (s : coq_type T) A (k : loc T -> coq_type T -> M A) :
cnew s >>= (fun r => cget r >>= k r) = cnew s >>= (fun r => k r s).
Proof.
apply/boolp.funext => e.
Expand All @@ -134,7 +134,7 @@ Lemma None_cput T (r : loc T) (s : coq_type T) e :
cput r s e = fail.
Proof. by move=> H; move: e H => [e] H; rewrite /cput H. Qed.

Lemma cnewput T (s t : coq_type T) A (k : loc T -> M A) :
Let cnewput T (s t : coq_type T) A (k : loc T -> M A) :
cnew s >>= (fun r => cput r t >> k r) = cnew t >>= k.
Proof.
apply/boolp.funext => e.
Expand All @@ -150,7 +150,7 @@ Definition permutable T1 T2 (A : UU0) (k : loc T1 -> loc T2 -> M A) :=
k (mkloc T1 n2) (mkloc T2 n1)
(mkEnv (set_nth def (set_nth def st n2 b1) n1 b2)).

Lemma cnewC T1 T2 (s : coq_type T1) (t : coq_type T2)
Let cnewC T1 T2 (s : coq_type T1) (t : coq_type T2)
A (k : loc T1 -> loc T2 -> M A) :
permutable k ->
cnew s >>= (fun r => cnew t >>= k r) =
Expand Down Expand Up @@ -180,7 +180,7 @@ case H : (nth_error (ofEnv e) (loc_id r)) => [[T' s']|].
exact: NthError_None.
Qed.

Lemma cgetput T (r : loc T) (s : coq_type T) : cget r >> cput r s = cput r s.
Let cgetput T (r : loc T) (s : coq_type T) : cget r >> cput r s = cput r s.
Proof.
apply/boolp.funext => e.
have [s' H|T' s' H Ts'|H] := ntherrorP e r.
Expand Down Expand Up @@ -215,7 +215,7 @@ by rewrite bindE/= (Some_cget s)// nth_error_set_nth.
Qed.
Arguments Some_cputget {T} s'.

Lemma cgetputskip T (r : loc T) : cget r >>= cput r = cget r >> skip.
Let cgetputskip T (r : loc T) : cget r >>= cput r = cget r >> skip.
Proof.
apply/boolp.funext => e /=.
have [s' H|T' s' H Ts'|H] := ntherrorP e r.
Expand All @@ -224,7 +224,7 @@ have [s' H|T' s' H Ts'|H] := ntherrorP e r.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cgetget T (r : loc T) (A : UU0) (k : coq_type T -> coq_type T -> M A) :
Let cgetget T (r : loc T) (A : UU0) (k : coq_type T -> coq_type T -> M A) :
cget r >>= (fun s => cget r >>= k s) = cget r >>= fun s => k s s.
Proof.
apply/boolp.funext => e /=.
Expand All @@ -234,7 +234,7 @@ have [s' H|T' s' H Ts'|H] := ntherrorP e r.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cputget T (r : loc T) (s: coq_type T) (A: UU0) (k: coq_type T -> M A) :
Let cputget T (r : loc T) (s: coq_type T) (A: UU0) (k: coq_type T -> M A) :
cput r s >> (cget r >>= k) = cput r s >> k s.
Proof.
apply/boolp.funext => e /=.
Expand All @@ -258,7 +258,7 @@ rewrite nth_error_set_nth coerce_Some/=.
by rewrite set_set_nth eqxx.
Qed.

Lemma cputput T (r : loc T) (s s' : coq_type T) :
Let cputput T (r : loc T) (s s' : coq_type T) :
cput r s >> cput r s' = cput r s'.
Proof.
apply/boolp.funext => e.
Expand All @@ -268,7 +268,7 @@ have [s'' H|T'' s'' H Ts''|H] := ntherrorP e r.
- by rewrite MS_bindE !None_cput.
Qed.

Lemma cgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (A : UU0)
Let cgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (A : UU0)
(k : coq_type T1 -> coq_type T2 -> M A) :
cget r1 >>= (fun u => cget r2 >>= (fun v => k u v)) =
cget r2 >>= (fun v => cget r1 >>= (fun u => k u v)).
Expand Down Expand Up @@ -302,7 +302,7 @@ rewrite bind_cnew//.
by rewrite (Some_cget v) // (nth_error_rcons_some _ H).
Qed.

Lemma cgetnewD T T' (r : loc T) (s : coq_type T') A
Let cgetnewD T T' (r : loc T) (s : coq_type T') A
(k : loc T' -> coq_type T -> coq_type T -> M A) :
cget r >>= (fun u => cnew s >>= fun r' => cget r >>= k r' u) =
cget r >>= (fun u => cnew s >>= fun r' => k r' u u).
Expand All @@ -314,7 +314,7 @@ have [u Hr|u T1 Hr T1u|Hr] := ntherrorP e r.
- by rewrite !MS_bindE None_cget.
Qed.

Lemma cgetnewE T1 T2 (r1 : loc T1) (s : coq_type T2) (A : UU0)
Let cgetnewE T1 T2 (r1 : loc T1) (s : coq_type T2) (A : UU0)
(k1 k2 : loc T2 -> M A) :
(forall r2 : loc T2, loc_id r1 != loc_id r2 -> k1 r2 = k2 r2) ->
cget r1 >> (cnew s >>= k1) = cget r1 >> (cnew s >>= k2).
Expand All @@ -329,7 +329,7 @@ have [u r1u|T' s' Hr1 T1s'|Hr] := ntherrorP e r1.
Qed.

(* TODO: do not rely on bindE to pass option and do not unfold cget *)
Lemma cgetputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s : coq_type T2) :
Let cgetputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s : coq_type T2) :
cget r1 >> cput r2 s = cput r2 s >> cget r1 >> skip.
Proof.
apply/boolp.funext => e /=.
Expand Down Expand Up @@ -394,7 +394,7 @@ have [v Hr2|T2' v Hr2 T2v|Hr2] := ntherrorP e r2; last first.
by rewrite (@nth_error_set_nth_other _ _ _ _ _ (mkbind s1')).
Qed.

Lemma cputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type T1)
Let cputC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type T1)
(s2 : coq_type T2) (A : UU0) :
loc_id r1 != loc_id r2 \/ JMeq s1 s2 ->
cput r1 s1 >> cput r2 s2 = cput r2 s2 >> cput r1 s1.
Expand Down Expand Up @@ -443,7 +443,7 @@ have [u Hr1|T1' s'd Hr1 T1s'|Hr1] := ntherrorP e r1; last first.
by rewrite set_set_nth (negbTE Hr).
Qed.

Lemma cputgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type T1)
Let cputgetC T1 T2 (r1 : loc T1) (r2 : loc T2) (s1 : coq_type T1)
(A : UU0) (k : coq_type T2 -> M A) :
loc_id r1 != loc_id r2 ->
cput r1 s1 >> cget r2 >>= k = cget r2 >>= (fun v => cput r1 s1 >> k v).
Expand Down Expand Up @@ -474,7 +474,7 @@ have [u Hr1|T1' s1' Hr1 T1s'|Hr1] := ntherrorP e r1.
+ by rewrite None_cget.
Qed.

Lemma cputnewC T T' (r : loc T) (s : coq_type T) (s' : coq_type T') A
Let cputnewC T T' (r : loc T) (s : coq_type T) (s' : coq_type T') A
(k : loc T' -> M A) :
cget r >> (cnew s' >>= fun r' => cput r s >> k r') =
cput r s >> (cnew s' >>= k).
Expand All @@ -492,18 +492,18 @@ have [u Hr|T1 s1' Hr T1s'|Hr] := ntherrorP e r.
- by rewrite 2!MS_bindE None_cget// bindfailf None_cput.
Qed.

Lemma crunret (A B : UU0) (m : M A) (s : B) :
Let crunret (A B : UU0) (m : M A) (s : B) :
crun m -> crun (m >> Ret s) = Some s.
Proof. by rewrite /crun /= MS_bindE/=; case: (m _) => //- []. Qed.

Lemma crunskip : crun skip = Some tt.
Let crunskip : crun skip = Some tt.
Proof. by []. Qed.

Lemma crunnew (A : UU0) T (m : M A) (s : A -> coq_type T) :
Let crunnew (A : UU0) T (m : M A) (s : A -> coq_type T) :
crun m -> crun (m >>= fun x => cnew (s x)).
Proof. by rewrite /crun /= MS_bindE; case: (m _) => // -[]. Qed.

Lemma crunnewget (A : UU0) T (m : M A) (s : A -> coq_type T) :
Let crunnewget (A : UU0) T (m : M A) (s : A -> coq_type T) :
crun m -> crun (m >>= fun x => cnew (s x) >>= @cget T).
Proof.
rewrite /crun /= MS_bindE.
Expand All @@ -512,7 +512,7 @@ by under eq_bind do under eq_uncurry do
rewrite -(bindmret (_ >>= _)) bindA cnewget.
Qed.

Lemma crungetnew (A : UU0) T1 T2 (m : M A) (r : A -> loc T1)
Let crungetnew (A : UU0) T1 T2 (m : M A) (r : A -> loc T1)
(s : A -> coq_type T2) :
crun (m >>= fun x => cget (r x)) ->
crun (m >>= fun x => cnew (s x) >> cget (r x)).
Expand All @@ -526,7 +526,7 @@ rewrite (nth_error_rcons_some _ Hnth).
by case Hcoe: coerce.
Qed.

Lemma crungetput (A : UU0) T (m : M A) (r : A -> loc T) (s : A -> coq_type T) :
Let crungetput (A : UU0) T (m : M A) (r : A -> loc T) (s : A -> coq_type T) :
crun (m >>= fun x => cget (r x)) ->
crun (m >>= fun x => cput (r x) (s x)).
Proof.
Expand Down
Loading