From mathcomp.ssreflect
From mathcomp
From fcsl
From DiSeL
From DiSeL
From DiSeL
From DiSeL
From DiSeL
Export CalculatorProtocol.
Section CalculatorServers.
Variable l : Label.
Variable f : input -> option nat.
Variable prec : input -> bool.
Variables (cs cls : seq nid).
Notation nodes := (cs ++ cls).
Hypothesis Huniq : uniq nodes.
Notation cal := (CalculatorProtocol f prec cs cls l).
Notation sts := (snd_trans cal).
Notation rts := (rcv_trans cal).
Notation W := (mkWorld cal).
(* A server node *)
Variable sv : nid.
Hypothesis  Hs : sv \in cs.
Notation loc i := (getLocal sv (getStatelet i l)).
Section CalculatorServerLoop.
(************************************************)
(******    Generic server loop combinator   *****)
(************************************************)
(* - Actually, this is _higher-order_ programming - The loop runs infinitely - It takes an additional generic state argument (useful for memoization), which should be constrained appropriately *)
Variable Sstate : Type.
(* Making sure that the state is okay *)
Variable state_wf : Pred Sstate.
(* Initial well-formed state, which is well-formed *)
Variable state0 : Sstate.
Hypothesis state0_wf : state_wf state0.
(** The server body always cleans up after itself (no outstanding requests left to be processed) and correctly handles the state, passed between iterations. *)
Definition server_loop_body_spec (s : Sstate) :=
DHT [sv, W]
(fun i => loc i = st :-> ([::]:reqs) /\ state_wf s,
fun (r : Sstate) m =>
[/\ loc m = st :-> ([::]:reqs) & state_wf r]).
(* The body to be passed to the loop *)
Variable server_body : forall s, server_loop_body_spec s.
Definition server_loop_cond (res : Sstate) := true.
Definition server_loop_inv :=
fun (_ r : Sstate) i => loc i = st :-> ([::]:reqs) /\ state_wf r.
Program Definition server_loop :
DHT [sv, W]
(fun i => loc i = st :-> ([::]:reqs),
fun (r : Sstate) m => False) :=
Do _ (@while sv W _ _ server_loop_cond server_loop_inv _
(fun r => Do _ (server_body r))) state0.
Next Obligation. by apply: with_spec (x x0). Defined.
Next Obligation.
by move:H; rewrite /server_loop_inv (rely_loc' _ H0).
Qed.
Next Obligation. by apply: with_spec x. Defined.
Next Obligation.
by apply: ghC=>i1 s[H1 H2] C1/=; apply: call_rule.
Qed.
Next Obligation.
move=>i/=E1; apply: call_rule'=>//.
- by move=>C1; exists state0=>//.
by move=>s' m/(_ s')/=; case.
Qed.
End CalculatorServerLoop.
End CalculatorServers.
(*************************************************)
(*      Specific server implementations          *)
(*************************************************)
(***** One-shot (per iteration) server *****)
Module OneShotServer.
Section OneShotServer.
Variable l : Label.
Variable f : input -> option nat.
Variable prec : input -> bool.
Hypothesis prec_valid :
forall i, prec i -> exists v, f i = Some v.
Variables (cs cls : seq nid).
Notation nodes := (cs ++ cls).
Hypothesis Huniq : uniq nodes.
Notation cal := (CalculatorProtocol f prec cs cls l).
Notation sts := (snd_trans cal).
Notation rts := (rcv_trans cal).
Notation W := (mkWorld cal).
(* A server node *)
Variable sv : nid.
Hypothesis  Hs : sv \in cs.
Notation loc i := (getLocal sv (getStatelet i l)).
(* Server-specific infrastructure *)
Notation Sstate := unit.
Definition state_wf := fun _ : unit => True.
Definition state0 := tt.

(* Specifications: *)
Lemma state0_wf : state_wf state0. Proof. done. Qed.
Program Definition one_shot_body : forall _ : unit,
server_loop_body_spec l f prec cs cls sv _ state_wf state0 :=
fun _ =>
Do _ (
r <-- blocking_receive_req l f prec cs cls _ Hs;
let: (from, args) := r in
let r := if f args is Some v then v else 0 in
send_answer l f prec cs cls _ Hs from args r;;
ret _ _ tt).