mirror of
https://github.com/achlipala/frap.git
synced 2024-11-10 00:07:51 +00:00
127 lines
3.4 KiB
Coq
127 lines
3.4 KiB
Coq
(** Formal Reasoning About Programs <http://adam.chlipala.net/frap/>
|
|
* Chapter 13: Operational Semantics for Shared-Memory Concurrency
|
|
* Author: Adam Chlipala
|
|
* License: https://creativecommons.org/licenses/by-nc-nd/4.0/ *)
|
|
|
|
Require Import Frap.
|
|
|
|
Set Implicit Arguments.
|
|
Set Asymmetric Patterns.
|
|
|
|
(** * Shared notations and definitions; main material starts afterward. *)
|
|
|
|
Notation "m $! k" := (match m $? k with Some n => n | None => O end) (at level 30).
|
|
Definition heap := fmap nat nat.
|
|
Definition assertion := heap -> Prop.
|
|
|
|
Hint Extern 1 (_ <= _) => linear_arithmetic.
|
|
Hint Extern 1 (@eq nat _ _) => linear_arithmetic.
|
|
|
|
Ltac simp := repeat (simplify; subst; propositional;
|
|
try match goal with
|
|
| [ H : ex _ |- _ ] => invert H
|
|
end); try linear_arithmetic.
|
|
|
|
|
|
(** * An object language with shared-memory concurrency *)
|
|
|
|
(* Let's simplify the encoding by only working with commands that generate
|
|
* [nat]. *)
|
|
Inductive loop_outcome :=
|
|
| Done (a : nat)
|
|
| Again (a : nat).
|
|
|
|
Inductive cmd :=
|
|
| Return (r : nat)
|
|
| Bind (c1 : cmd) (c2 : nat -> cmd)
|
|
| Read (a : nat)
|
|
| Write (a v : nat)
|
|
| Fail
|
|
|
|
(* Now here's the new part: parallel composition of commands. *)
|
|
| Par (c1 c2 : cmd)
|
|
|
|
(* Let's also add locking commands, where locks are named by [nat]s. *)
|
|
| Lock (a : nat)
|
|
| Unlock (a : nat).
|
|
|
|
Notation "x <- c1 ; c2" := (Bind c1 (fun x => c2)) (right associativity, at level 80).
|
|
Infix "||" := Par.
|
|
|
|
Definition locks := set nat.
|
|
|
|
Inductive step : heap * locks * cmd -> heap * locks * cmd -> Prop :=
|
|
| StepBindRecur : forall c1 c1' c2 h h' l l',
|
|
step (h, l, c1) (h', l', c1')
|
|
-> step (h, l, Bind c1 c2) (h', l', Bind c1' c2)
|
|
| StepBindProceed : forall v c2 h l,
|
|
step (h, l, Bind (Return v) c2) (h, l, c2 v)
|
|
|
|
| StepRead : forall h l a,
|
|
step (h, l, Read a) (h, l, Return (h $! a))
|
|
| StepWrite : forall h l a v,
|
|
step (h, l, Write a v) (h $+ (a, v), l, Return 0)
|
|
|
|
| StepParRecur1 : forall h l c1 c2 h' l' c1',
|
|
step (h, l, c1) (h', l', c1')
|
|
-> step (h, l, Par c1 c2) (h', l', Par c1' c2)
|
|
| StepParRecur2 : forall h l c1 c2 h' l' c2',
|
|
step (h, l, c2) (h', l', c2')
|
|
-> step (h, l, Par c1 c2) (h', l', Par c1 c2')
|
|
| StepParProceed : forall h l,
|
|
step (h, l, Par (Return 0) (Return 0)) (h, l, Return 0)
|
|
|
|
| StepLock : forall h l a,
|
|
~a \in l
|
|
-> step (h, l, Lock a) (h, l \cup {a}, Return 0)
|
|
| StepUnlock : forall h l a,
|
|
a \in l
|
|
-> step (h, l, Unlock a) (h, l \setminus {a}, Return 0).
|
|
|
|
Definition trsys_of (h : heap) (l : locks) (c : cmd) := {|
|
|
Initial := {(h, l, c)};
|
|
Step := step
|
|
|}.
|
|
|
|
|
|
Example two_increments_thread :=
|
|
_ <- Lock 0;
|
|
n <- Read 0;
|
|
_ <- Write 0 (n + 1);
|
|
Unlock 0.
|
|
|
|
Example two_increments := two_increments_thread || two_increments_thread.
|
|
|
|
Theorem two_increments_ok :
|
|
invariantFor (trsys_of $0 {} two_increments)
|
|
(fun p => let '(h, l, c) := p in
|
|
c = Return 0
|
|
-> h $! 0 = 2).
|
|
Proof.
|
|
unfold two_increments, two_increments_thread.
|
|
simplify.
|
|
eapply invariant_weaken.
|
|
apply multiStepClosure_ok; simplify.
|
|
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_step.
|
|
model_check_done.
|
|
|
|
simplify.
|
|
propositional; subst; try equality.
|
|
simplify.
|
|
reflexivity.
|
|
Qed.
|