mirror of
https://github.com/achlipala/frap.git
synced 2024-11-10 00:07:51 +00:00
SessionTypes: a fuller multiparty example
This commit is contained in:
Adam Chlipala
parent
a86ecf84ad
commit
1fdf19f4f0
1 changed files with 134 additions and 27 deletions
161
SessionTypes.v
161
SessionTypes.v
|
|
@ -274,7 +274,7 @@ Section parties.
|
|||
| HtRecv : forall mayNotSend ch sr (A : Set) (k : A -> _) t (witness : A),
|
||||
channels ch = {| Sender := sr; Receiver := p |}
|
||||
-> sr <> p
|
||||
-> (forall v, hasty p mayNotSend (k v) (t v))
|
||||
-> (forall v, hasty p false (k v) (t v))
|
||||
-> hasty p mayNotSend (Recv ch k) (Communicate ch t)
|
||||
| HtSkip : forall mayNotSend ch sr rr (A : Set) pr (t : A -> _) (witness : A),
|
||||
channels ch = {| Sender := sr; Receiver := rr |}
|
||||
|
|
@ -286,6 +286,7 @@ Section parties.
|
|||
hasty p mayNotSend Done TDone.
|
||||
End parties.
|
||||
|
||||
|
||||
(** * Parallel execution preserves the existence of complementary session types. *)
|
||||
|
||||
Definition trsys_of pr := {|
|
||||
|
|
@ -378,6 +379,32 @@ Inductive typed_multistate party (channels : channel -> parties party) (t : type
|
|||
|
||||
Hint Constructors typed_multistate.
|
||||
|
||||
|
||||
Ltac side :=
|
||||
match goal with
|
||||
| [ |- ?E = {| Sender := _; Receiver := _ |} ] =>
|
||||
let E' := eval hnf in E in change E with E';
|
||||
repeat match goal with
|
||||
| [ |- context[if ?E then _ else _] ] => cases E; try (exfalso; equality)
|
||||
end;
|
||||
try (exfalso; equality);
|
||||
repeat match goal with
|
||||
| [ H : NoDup _ |- _ ] => invert H
|
||||
end; simplify; try (exfalso; equality); equality
|
||||
| [ |- _ <> _ ] => equality
|
||||
end.
|
||||
|
||||
Ltac hasty := simplify; repeat match goal with
|
||||
| [ |- typed_multistate _ _ _ _ ] => econstructor; simplify
|
||||
| [ |- hasty _ _ _ _ _ ] =>
|
||||
apply HtDone
|
||||
|| (eapply HtSend; [ side | side | ])
|
||||
|| (eapply HtRecv; [ constructor | side | side | simplify ])
|
||||
|| (eapply HtSkip; [ constructor | side | side | side | simplify ])
|
||||
| [ |- hasty _ _ _ _ (match ?E with _ => _ end) ] => cases E
|
||||
| [ |- hasty _ _ _ (match ?E with _ => _ end) _ ] => cases E
|
||||
end.
|
||||
|
||||
Lemma no_silent_steps : forall party (channels : _ -> parties party) p mns pr t,
|
||||
hasty channels p mns pr t
|
||||
-> forall pr', lstep pr Silent pr'
|
||||
|
|
@ -415,7 +442,6 @@ Proof.
|
|||
induct 1; eauto; invert 1.
|
||||
Unshelve.
|
||||
assumption.
|
||||
assumption.
|
||||
Qed.
|
||||
|
||||
Hint Immediate mayNotSend_really.
|
||||
|
|
@ -1014,31 +1040,6 @@ Section online_store.
|
|||
{| Sender := Merchant;
|
||||
Receiver := Customer |}.
|
||||
|
||||
Ltac side :=
|
||||
match goal with
|
||||
| [ |- ?E = {| Sender := _; Receiver := _ |} ] =>
|
||||
let E' := eval hnf in E in change E with E';
|
||||
repeat match goal with
|
||||
| [ |- context[if ?E then _ else _] ] => cases E; try equality
|
||||
end;
|
||||
try equality;
|
||||
repeat match goal with
|
||||
| [ H : NoDup _ |- _ ] => invert H
|
||||
end; simplify; equality
|
||||
| [ |- _ <> _ ] => equality
|
||||
end.
|
||||
|
||||
Ltac hasty := simplify; repeat match goal with
|
||||
| [ |- typed_multistate _ _ _ _ ] => econstructor; simplify
|
||||
| [ |- hasty _ _ _ _ _ ] =>
|
||||
apply HtDone
|
||||
|| (eapply HtSend; [ side | side | ])
|
||||
|| (eapply HtRecv; [ constructor | side | side | simplify ])
|
||||
|| (eapply HtSkip; [ constructor | side | side | side | ])
|
||||
| [ |- hasty _ _ _ _ (match ?E with _ => _ end) ] => cases E
|
||||
| [ |- hasty _ _ _ (match ?E with _ => _ end) _ ] => cases E
|
||||
end.
|
||||
|
||||
Example online_store_no_deadlock : forall product payment_info in_stock payment_checker,
|
||||
NoDup [request_product; in_stock_or_not; send_payment_info; payment_success; add_review]
|
||||
-> invariantFor (trsys_of (customer product payment_info
|
||||
|
|
@ -1061,4 +1062,110 @@ Section online_store.
|
|||
Qed.
|
||||
End online_store.
|
||||
|
||||
Inductive store_party' := Customer' | Merchant' | Warehouse.
|
||||
|
||||
Section online_store_with_warehouse.
|
||||
Variables request_product in_stock_or_not send_payment_info payment_success add_review
|
||||
merchant_to_warehouse warehouse_to_merchant : channel.
|
||||
|
||||
Definition customer' (product payment_info : string) :=
|
||||
!!request_product(product);
|
||||
??in_stock_or_not(worked : bool);
|
||||
if worked then
|
||||
!!send_payment_info(payment_info);
|
||||
??payment_success(worked_again : bool);
|
||||
if worked_again then
|
||||
!!add_review((product, "awesome"));
|
||||
Done
|
||||
else
|
||||
Done
|
||||
else
|
||||
Done.
|
||||
|
||||
Definition merchant' (payment_checker : string -> bool) :=
|
||||
??request_product(product : string);
|
||||
!!merchant_to_warehouse(product);
|
||||
??warehouse_to_merchant(in_stock : bool);
|
||||
if in_stock then
|
||||
!!in_stock_or_not(true);
|
||||
??send_payment_info(payment_info : string);
|
||||
if payment_checker payment_info then
|
||||
!!payment_success(true);
|
||||
??add_review(_ : (string * string)%type);
|
||||
Done
|
||||
else
|
||||
!!payment_success(false);
|
||||
Done
|
||||
else
|
||||
!!in_stock_or_not(false);
|
||||
Done.
|
||||
|
||||
Definition warehouse (in_stock : string -> bool) :=
|
||||
??merchant_to_warehouse(product : string);
|
||||
if in_stock product then
|
||||
!!warehouse_to_merchant(true);
|
||||
Done
|
||||
else
|
||||
!!warehouse_to_merchant(false);
|
||||
Done.
|
||||
|
||||
Definition online_store_type' :=
|
||||
(!!!request_product(_ : string);
|
||||
!!!merchant_to_warehouse(_ : string);
|
||||
!!!warehouse_to_merchant(_ : bool);
|
||||
!!!in_stock_or_not(worked : bool);
|
||||
if worked then
|
||||
!!!send_payment_info(_ : string);
|
||||
!!!payment_success(worked_again : bool);
|
||||
if worked_again then
|
||||
!!!add_review(_ : (string * string)%type);
|
||||
TDone
|
||||
else
|
||||
TDone
|
||||
else
|
||||
TDone)%st.
|
||||
|
||||
Definition online_store_channels' (ch : channel) :=
|
||||
if ch ==n request_product then
|
||||
{| Sender := Customer';
|
||||
Receiver := Merchant' |}
|
||||
else if ch ==n send_payment_info then
|
||||
{| Sender := Customer';
|
||||
Receiver := Merchant' |}
|
||||
else if ch ==n add_review then
|
||||
{| Sender := Customer';
|
||||
Receiver := Merchant' |}
|
||||
else if ch ==n merchant_to_warehouse then
|
||||
{| Sender := Merchant';
|
||||
Receiver := Warehouse |}
|
||||
else if ch ==n warehouse_to_merchant then
|
||||
{| Sender := Warehouse;
|
||||
Receiver := Merchant' |}
|
||||
else
|
||||
{| Sender := Merchant';
|
||||
Receiver := Customer' |}.
|
||||
|
||||
Example online_store_no_deadlock' : forall product payment_info in_stock good_infos,
|
||||
NoDup [request_product; in_stock_or_not; send_payment_info; payment_success; add_review;
|
||||
merchant_to_warehouse; warehouse_to_merchant]
|
||||
-> invariantFor (trsys_of (customer' product payment_info
|
||||
|| (merchant' in_stock
|
||||
|| (warehouse good_infos || Done))))
|
||||
(fun pr => inert pr
|
||||
\/ exists pr', lstep pr Silent pr').
|
||||
Proof.
|
||||
simplify.
|
||||
eapply no_deadlock with (t := online_store_type')
|
||||
(all_parties := [Customer'; Merchant'; Warehouse])
|
||||
(channels := online_store_channels');
|
||||
simplify.
|
||||
|
||||
repeat constructor; simplify; equality.
|
||||
|
||||
cases p; auto.
|
||||
|
||||
hasty; constructor.
|
||||
Qed.
|
||||
End online_store_with_warehouse.
|
||||
|
||||
End Multiparty.
|
||||
|
|
|
|||
Loading…
Reference in a new issue