Commit 9646293e authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan
Browse files

A specific constructor for injecting values in expressions

We add a specific constructor to the type of expressions for injecting
values in expressions.

The advantage are :
- Values can be assumed to be always closed when performing
  substitutions (even though they could contain free variables, but it
  turns out it does not cause any problem in the proofs in
  practice). This means that we no longer need the `Closed` typeclass
  and everything that comes with it (all the reflection-based machinery
  contained in tactics.v is no longer necessary). I have not measured
  anything, but I guess this would have a significant performance
  impact.

- There is only one constructor for values. As a result, the AsVal and
  IntoVal typeclasses are no longer necessary: an expression which is
  a value will always unify with `Val _`, and therefore lemmas can be
  stated using this constructor.

Of course, this means that there are two ways of writing such a thing
as "The pair of integers 1 and 2": Either by using the value
constructor applied to the pair represented as a value, or by using
the expression pair constructor. So we add reduction rules that
transform reduced pair, injection and closure expressions into values.
At first, this seems weird, because of the redundancy. But in fact,
this has some meaning, since the machine migth actually be doing
something to e.g., allocate the pair or the closure.

These additional steps of computation show up in the proofs, and some
additional wp_* tactics need to be called.
parent 1f796221
......@@ -81,6 +81,7 @@ theories/program_logic/total_lifting.v
theories/program_logic/total_ectx_lifting.v
theories/program_logic/atomic.v
theories/heap_lang/lang.v
theories/heap_lang/metatheory.v
theories/heap_lang/tactics.v
theories/heap_lang/lifting.v
theories/heap_lang/notation.v
......
......@@ -50,6 +50,18 @@
--------------------------------------∗
True
The command has indeed failed with message:
Ltac call to "wp_pure (open_constr)" failed.
Tactic failure: wp_pure: cannot find ?y in (Var "x") or
?y is not a redex.
1 subgoal
Σ : gFunctors
H : heapG Σ
============================
--------------------------------------∗
WP "x" {{ _, True }}
1 subgoal
Σ : gFunctors
......@@ -104,4 +116,4 @@
: string
The command has indeed failed with message:
Ltac call to "wp_cas_suc" failed.
Tactic failure: wp_cas_suc: cannot find 'CAS' in (#())%E.
Tactic failure: wp_cas_suc: cannot find 'CAS' in (Val #()).
......@@ -131,6 +131,10 @@ Section tests.
WP Alloc #0 {{ _, True }}%I.
Proof. wp_alloc l as "_". Show. done. Qed.
Lemma wp_nonclosed_value :
WP let: "x" := #() in (λ: "y", "x")%V #() {{ _, True }}%I.
Proof. wp_let. wp_lam. Fail wp_pure _. Show. Abort.
End tests.
Section printing_tests.
......
......@@ -82,14 +82,14 @@ Section list_reverse.
destruct xs as [|x xs]; iSimplifyEq.
- (* nil *) by wp_match.
- (* cons *) iDestruct "Hxs" as (l hd') "(% & Hx & Hxs)"; iSimplifyEq.
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store.
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_pair. wp_store.
rewrite reverse_cons -assoc.
iApply ("IH" $! hd' (InjRV #l) xs (x :: ys) with "Hxs [Hx Hys]").
iExists l, acc; by iFrame.
Qed.
Lemma rev_ht hd xs :
{{ is_list hd xs }} rev hd NONE {{ w, is_list w (reverse xs) }}.
{{ is_list hd xs }} rev hd NONEV {{ w, is_list w (reverse xs) }}.
Proof.
iIntros "!# Hxs". rewrite -(right_id_L [] (++) (reverse xs)).
iApply (rev_acc_ht hd NONEV with "[Hxs]"); simpl; by iFrame.
......@@ -204,7 +204,7 @@ Section counter_proof.
Lemma newcounter_spec :
{{ True }} newcounter #() {{ v, l, v = #l C l 0 }}.
Proof.
iIntros "!# _ /=". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl".
iIntros "!# _ /=". rewrite -wp_fupd /newcounter /=. wp_lam. wp_alloc l as "Hl".
iMod (own_alloc (Auth 0)) as (γ) "Hγ"; first done.
rewrite (auth_frag_op 0 0) //; iDestruct "Hγ" as "[Hγ Hγf]".
set (N:= nroot .@ "counter").
......@@ -242,7 +242,7 @@ Section counter_proof.
{{ C l n }} read #l {{ v, m : nat, v = #m n m C l m }}.
Proof.
iIntros "!# Hl /=". iDestruct "Hl" as (N γ) "[#Hinv Hγf]".
rewrite /read /=. wp_let. Show. iApply wp_inv_open; last iFrame "Hinv"; auto.
rewrite /read /=. wp_lam. Show. iApply wp_inv_open; last iFrame "Hinv"; auto.
iDestruct 1 as (c) "[Hl Hγ]". wp_load. Show.
iDestruct (own_valid γ (Frag n Auth c) with "[-]") as % ?%auth_frag_valid.
{ iApply own_op. by iFrame. }
......
......@@ -23,11 +23,11 @@
"Hys" : is_list acc ys
"HΦ" : ∀ w : val, is_list w ys -∗ Φ w
--------------------------------------∗
WP match: InjL #() with
WP match: InjLV #() with
InjL <> => acc
| InjR "l" =>
let: "tmp1" := Fst ! "l" in
let: "tmp2" := Snd ! "l" in
"l" <- ("tmp1", acc);; (rev "tmp2") (InjL #())
"l" <- ("tmp1", acc);; (rev "tmp2") (InjLV #())
end [{ v, Φ v }]
......@@ -36,14 +36,14 @@ Proof.
iSimplifyEq; wp_rec; wp_let.
- Show. wp_match. by iApply "HΦ".
- iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]".
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store.
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_pair. wp_store.
iApply ("IH" $! hd' (SOMEV #l) (x :: ys) with "Hxs [Hx Hys]"); simpl.
{ iExists l, acc; by iFrame. }
iIntros (w). rewrite cons_middle assoc -reverse_cons. iApply "HΦ".
Qed.
Lemma rev_wp hd xs :
[[{ is_list hd xs }]] rev hd NONE [[{ w, RET w; is_list w (reverse xs) }]].
[[{ is_list hd xs }]] rev hd NONEV [[{ w, RET w; is_list w (reverse xs) }]].
Proof.
iIntros (Φ) "Hxs HΦ".
iApply (rev_acc_wp hd NONEV xs [] with "[$Hxs //]").
......
......@@ -35,7 +35,7 @@
"Hγ" : own γ (Shot m')
--------------------------------------∗
|={⊤ ∖ ↑N}=> ▷ one_shot_inv γ l
∗ WP match: InjR #m' with
∗ WP match: InjRV #m' with
InjL <> => assert: #false
| InjR "m" => assert: #m = "m"
end {{ _, True }}
......
......@@ -43,12 +43,12 @@ Lemma wp_one_shot (Φ : val → iProp Σ) :
WP one_shot_example #() {{ Φ }}.
Proof.
iIntros "Hf /=". pose proof (nroot .@ "N") as N.
rewrite -wp_fupd /one_shot_example /=. wp_seq. wp_alloc l as "Hl". wp_let.
rewrite -wp_fupd /one_shot_example /=. wp_lam. wp_inj. wp_alloc l as "Hl". wp_let.
iMod (own_alloc Pending) as (γ) "Hγ"; first done.
iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN".
{ iNext. iLeft. by iSplitL "Hl". }
iModIntro. iApply "Hf"; iSplit.
- iIntros (n) "!#". wp_let.
wp_closure. wp_closure. wp_pair. iModIntro. iApply "Hf"; iSplit.
- iIntros (n) "!#". wp_lam. wp_inj. wp_inj.
iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]".
+ iMod (own_update with "Hγ") as "Hγ".
{ by apply cmra_update_exclusive with (y:=Shot n). }
......@@ -56,7 +56,7 @@ Proof.
iModIntro. iNext; iRight; iExists n; by iFrame.
+ wp_cas_fail. iSplitL; last eauto.
rewrite /one_shot_inv; eauto 10.
- iIntros "!# /=". wp_seq. wp_bind (! _)%E.
- iIntros "!# /=". wp_lam. wp_bind (! _)%E.
iInv N as ">Hγ".
iAssert ( v, l v ((v = NONEV own γ Pending)
n : Z, v = SOMEV #n own γ (Shot n)))%I with "[Hγ]" as "Hv".
......@@ -70,7 +70,7 @@ Proof.
+ Show. iSplit. iLeft; by iSplitL "Hl". eauto.
+ iSplit. iRight; iExists m; by iSplitL "Hl". eauto. }
iSplitL "Hinv"; first by eauto.
iModIntro. wp_let. iIntros "!#". wp_seq.
iModIntro. wp_let. wp_closure. iIntros "!#". wp_lam.
iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst.
{ by wp_match. }
wp_match. wp_bind (! _)%E.
......
......@@ -58,7 +58,7 @@ Lemma sum_wp `{!heapG Σ} v t :
[[{ is_tree v t }]] sum' v [[{ RET #(sum t); is_tree v t }]].
Proof.
iIntros (Φ) "Ht HΦ". rewrite /sum' /=.
wp_let. wp_alloc l as "Hl". wp_let.
wp_lam. wp_alloc l as "Hl". wp_let.
wp_apply (sum_loop_wp with "[$Hl $Ht]").
rewrite Z.add_0_r.
iIntros "[Hl Ht]". wp_seq. wp_load. by iApply "HΦ".
......
......@@ -59,12 +59,13 @@ Proof.
Qed.
Inductive expr :=
(* Values *)
| Val (v : val)
(* Base lambda calculus *)
| Var (x : string)
| Rec (f x : binder) (e : expr)
| App (e1 e2 : expr)
(* Base types and their operations *)
| Lit (l : base_lit)
| UnOp (op : un_op) (e : expr)
| BinOp (op : bin_op) (e1 e2 : expr)
| If (e0 e1 e2 : expr)
......@@ -86,57 +87,24 @@ Inductive expr :=
| FAA (e1 : expr) (e2 : expr)
(* Prophecy *)
| NewProph
| ResolveProph (e1 : expr) (e2 : expr).
Bind Scope expr_scope with expr.
Fixpoint is_closed (X : list string) (e : expr) : bool :=
match e with
| Var x => bool_decide (x X)
| Rec f x e => is_closed (f :b: x :b: X) e
| Lit _ | NewProph => true
| UnOp _ e | Fst e | Snd e | InjL e | InjR e | Fork e | Alloc e | Load e =>
is_closed X e
| App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 | FAA e1 e2 | ResolveProph e1 e2 =>
is_closed X e1 && is_closed X e2
| If e0 e1 e2 | Case e0 e1 e2 | CAS e0 e1 e2 =>
is_closed X e0 && is_closed X e1 && is_closed X e2
end.
Class Closed (X : list string) (e : expr) := closed : is_closed X e.
Instance closed_proof_irrel X e : ProofIrrel (Closed X e).
Proof. rewrite /Closed. apply _. Qed.
Instance closed_dec X e : Decision (Closed X e).
Proof. rewrite /Closed. apply _. Defined.
Inductive val :=
| RecV (f x : binder) (e : expr) `{!Closed (f :b: x :b: []) e}
| ResolveProph (e1 : expr) (e2 : expr)
with val :=
| LitV (l : base_lit)
| RecV (f x : binder) (e : expr)
| PairV (v1 v2 : val)
| InjLV (v : val)
| InjRV (v : val).
Bind Scope expr_scope with expr.
Bind Scope val_scope with val.
Definition observation : Set := proph_id * val.
Fixpoint of_val (v : val) : expr :=
match v with
| RecV f x e => Rec f x e
| LitV l => Lit l
| PairV v1 v2 => Pair (of_val v1) (of_val v2)
| InjLV v => InjL (of_val v)
| InjRV v => InjR (of_val v)
end.
Notation of_val := Val (only parsing).
Fixpoint to_val (e : expr) : option val :=
Definition to_val (e : expr) : option val :=
match e with
| Rec f x e =>
if decide (Closed (f :b: x :b: []) e) then Some (RecV f x e) else None
| Lit l => Some (LitV l)
| Pair e1 e2 => v1 to_val e1; v2 to_val e2; Some (PairV v1 v2)
| InjL e => InjLV <$> to_val e
| InjR e => InjRV <$> to_val e
| Val v => Some v
| _ => None
end.
......@@ -180,17 +148,13 @@ Record state : Type := {
(** Equality and other typeclass stuff *)
Lemma to_of_val v : to_val (of_val v) = Some v.
Proof.
by induction v; simplify_option_eq; repeat f_equal; try apply (proof_irrel _).
Qed.
Proof. by destruct v. Qed.
Lemma of_to_val e v : to_val e = Some v of_val v = e.
Proof.
revert v; induction e; intros v ?; simplify_option_eq; auto with f_equal.
Qed.
Proof. destruct e=>//=. by intros [= <-]. Qed.
Instance of_val_inj : Inj (=) (=) of_val.
Proof. by intros ?? Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed.
Proof. intros ??. congruence. Qed.
Instance base_lit_eq_dec : EqDecision base_lit.
Proof. solve_decision. Defined.
......@@ -199,11 +163,57 @@ Proof. solve_decision. Defined.
Instance bin_op_eq_dec : EqDecision bin_op.
Proof. solve_decision. Defined.
Instance expr_eq_dec : EqDecision expr.
Proof. solve_decision. Defined.
Instance val_eq_dec : EqDecision val.
Proof.
refine (λ v v', cast_if (decide (of_val v = of_val v'))); abstract naive_solver.
refine (
fix go (e1 e2 : expr) {struct e1} : Decision (e1 = e2) :=
match e1, e2 with
| Val v, Val v' => cast_if (decide (v = v'))
| Var x, Var x' => cast_if (decide (x = x'))
| Rec f x e, Rec f' x' e' =>
cast_if_and3 (decide (f = f')) (decide (x = x')) (decide (e = e'))
| App e1 e2, App e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| UnOp o e, UnOp o' e' => cast_if_and (decide (o = o')) (decide (e = e'))
| BinOp o e1 e2, BinOp o' e1' e2' =>
cast_if_and3 (decide (o = o')) (decide (e1 = e1')) (decide (e2 = e2'))
| If e0 e1 e2, If e0' e1' e2' =>
cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
| Pair e1 e2, Pair e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| Fst e, Fst e' => cast_if (decide (e = e'))
| Snd e, Snd e' => cast_if (decide (e = e'))
| InjL e, InjL e' => cast_if (decide (e = e'))
| InjR e, InjR e' => cast_if (decide (e = e'))
| Case e0 e1 e2, Case e0' e1' e2' =>
cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
| Fork e, Fork e' => cast_if (decide (e = e'))
| Alloc e, Alloc e' => cast_if (decide (e = e'))
| Load e, Load e' => cast_if (decide (e = e'))
| Store e1 e2, Store e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| CAS e0 e1 e2, CAS e0' e1' e2' =>
cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
| FAA e1 e2, FAA e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| NewProph, NewProph => left _
| ResolveProph e1 e2, ResolveProph e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| _, _ => right _
end
with gov (v1 v2 : val) {struct v1} : Decision (v1 = v2) :=
match v1, v2 with
| LitV l, LitV l' => cast_if (decide (l = l'))
| RecV f x e, RecV f' x' e' =>
cast_if_and3 (decide (f = f')) (decide (x = x')) (decide (e = e'))
| PairV e1 e2, PairV e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| InjLV e, InjLV e' => cast_if (decide (e = e'))
| InjRV e, InjRV e' => cast_if (decide (e = e'))
| _, _ => right _
end
for go); try (clear go gov; abstract intuition congruence).
Defined.
Instance val_eq_dec : EqDecision val.
Proof. solve_decision. Defined.
Instance base_lit_countable : Countable base_lit.
Proof.
......@@ -241,64 +251,90 @@ Proof.
Qed.
Instance expr_countable : Countable expr.
Proof.
set (enc := fix go e :=
match e with
| Var x => GenLeaf (Some (inl (inl x)))
| Rec f x e => GenNode 0 [GenLeaf (Some ((inl (inr f)))); GenLeaf (Some (inl (inr x))); go e]
| App e1 e2 => GenNode 1 [go e1; go e2]
| Lit l => GenLeaf (Some (inr (inl l)))
| UnOp op e => GenNode 2 [GenLeaf (Some (inr (inr (inl op)))); go e]
| BinOp op e1 e2 => GenNode 3 [GenLeaf (Some (inr (inr (inr op)))); go e1; go e2]
| If e0 e1 e2 => GenNode 4 [go e0; go e1; go e2]
| Pair e1 e2 => GenNode 5 [go e1; go e2]
| Fst e => GenNode 6 [go e]
| Snd e => GenNode 7 [go e]
| InjL e => GenNode 8 [go e]
| InjR e => GenNode 9 [go e]
| Case e0 e1 e2 => GenNode 10 [go e0; go e1; go e2]
| Fork e => GenNode 11 [go e]
| Alloc e => GenNode 12 [go e]
| Load e => GenNode 13 [go e]
| Store e1 e2 => GenNode 14 [go e1; go e2]
| CAS e0 e1 e2 => GenNode 15 [go e0; go e1; go e2]
| FAA e1 e2 => GenNode 16 [go e1; go e2]
| NewProph => GenLeaf None
| ResolveProph e1 e2 => GenNode 17 [go e1; go e2]
end).
set (dec := fix go e :=
match e with
| GenLeaf (Some(inl (inl x))) => Var x
| GenNode 0 [GenLeaf (Some (inl (inr f))); GenLeaf (Some (inl (inr x))); e] => Rec f x (go e)
| GenNode 1 [e1; e2] => App (go e1) (go e2)
| GenLeaf (Some (inr (inl l))) => Lit l
| GenNode 2 [GenLeaf (Some (inr (inr (inl op)))); e] => UnOp op (go e)
| GenNode 3 [GenLeaf (Some (inr (inr (inr op)))); e1; e2] => BinOp op (go e1) (go e2)
| GenNode 4 [e0; e1; e2] => If (go e0) (go e1) (go e2)
| GenNode 5 [e1; e2] => Pair (go e1) (go e2)
| GenNode 6 [e] => Fst (go e)
| GenNode 7 [e] => Snd (go e)
| GenNode 8 [e] => InjL (go e)
| GenNode 9 [e] => InjR (go e)
| GenNode 10 [e0; e1; e2] => Case (go e0) (go e1) (go e2)
| GenNode 11 [e] => Fork (go e)
| GenNode 12 [e] => Alloc (go e)
| GenNode 13 [e] => Load (go e)
| GenNode 14 [e1; e2] => Store (go e1) (go e2)
| GenNode 15 [e0; e1; e2] => CAS (go e0) (go e1) (go e2)
| GenNode 16 [e1; e2] => FAA (go e1) (go e2)
| GenLeaf None => NewProph
| GenNode 17 [e1; e2] => ResolveProph (go e1) (go e2)
| _ => Lit LitUnit (* dummy *)
end).
refine (inj_countable' enc dec _). intros e. induction e; f_equal/=; auto.
set (enc :=
fix go e :=
match e with
| Val v => GenNode 0 [gov v]
| Var x => GenLeaf (inl (inl x))
| Rec f x e => GenNode 1 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); go e]
| App e1 e2 => GenNode 2 [go e1; go e2]
| UnOp op e => GenNode 3 [GenLeaf (inr (inr (inl op))); go e]
| BinOp op e1 e2 => GenNode 4 [GenLeaf (inr (inr (inr op))); go e1; go e2]
| If e0 e1 e2 => GenNode 5 [go e0; go e1; go e2]
| Pair e1 e2 => GenNode 6 [go e1; go e2]
| Fst e => GenNode 7 [go e]
| Snd e => GenNode 8 [go e]
| InjL e => GenNode 9 [go e]
| InjR e => GenNode 10 [go e]
| Case e0 e1 e2 => GenNode 11 [go e0; go e1; go e2]
| Fork e => GenNode 12 [go e]
| Alloc e => GenNode 13 [go e]
| Load e => GenNode 14 [go e]
| Store e1 e2 => GenNode 15 [go e1; go e2]
| CAS e0 e1 e2 => GenNode 16 [go e0; go e1; go e2]
| FAA e1 e2 => GenNode 17 [go e1; go e2]
| NewProph => GenNode 18 []
| ResolveProph e1 e2 => GenNode 19 [go e1; go e2]
end
with gov v :=
match v with
| LitV l => GenLeaf (inr (inl l))
| RecV f x e =>
GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); go e]
| PairV v1 v2 => GenNode 1 [gov v1; gov v2]
| InjLV v => GenNode 2 [gov v]
| InjRV v => GenNode 3 [gov v]
end
for go).
set (dec :=
fix go e :=
match e with
| GenNode 0 [v] => Val (gov v)
| GenLeaf (inl (inl x)) => Var x
| GenNode 1 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); e] => Rec f x (go e)
| GenNode 2 [e1; e2] => App (go e1) (go e2)
| GenNode 3 [GenLeaf (inr (inr (inl op))); e] => UnOp op (go e)
| GenNode 4 [GenLeaf (inr (inr (inr op))); e1; e2] => BinOp op (go e1) (go e2)
| GenNode 5 [e0; e1; e2] => If (go e0) (go e1) (go e2)
| GenNode 6 [e1; e2] => Pair (go e1) (go e2)
| GenNode 7 [e] => Fst (go e)
| GenNode 8 [e] => Snd (go e)
| GenNode 9 [e] => InjL (go e)
| GenNode 10 [e] => InjR (go e)
| GenNode 11 [e0; e1; e2] => Case (go e0) (go e1) (go e2)
| GenNode 12 [e] => Fork (go e)
| GenNode 13 [e] => Alloc (go e)
| GenNode 14 [e] => Load (go e)
| GenNode 15 [e1; e2] => Store (go e1) (go e2)
| GenNode 16 [e0; e1; e2] => CAS (go e0) (go e1) (go e2)
| GenNode 17 [e1; e2] => FAA (go e1) (go e2)
| GenNode 18 [] => NewProph
| GenNode 19 [e1; e2] => ResolveProph (go e1) (go e2)
| _ => Val $ LitV LitUnit (* dummy *)
end
with gov v :=
match v with
| GenLeaf (inr (inl l)) => LitV l
| GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); e] => RecV f x (go e)
| GenNode 1 [v1; v2] => PairV (gov v1) (gov v2)
| GenNode 2 [v] => InjLV (gov v)
| GenNode 3 [v] => InjRV (gov v)
| _ => LitV LitUnit (* dummy *)
end
for go).
refine (inj_countable' enc dec _).
refine (fix go (e : expr) {struct e} := _ with gov (v : val) {struct v} := _ for go).
- destruct e as [v| | | | | | | | | | | | | | | | | | | |]; simpl; f_equal;
[exact (gov v)|done..].
- destruct v; by f_equal.
Qed.
Instance val_countable : Countable val.
Proof. refine (inj_countable of_val to_val _); auto using to_of_val. Qed.
Instance state_inhabited : Inhabited state :=
populate {| heap := inhabitant; used_proph_id := inhabitant |}.
Instance expr_inhabited : Inhabited expr := populate (Lit LitUnit).
Instance val_inhabited : Inhabited val := populate (LitV LitUnit).
Instance expr_inhabited : Inhabited expr := populate (Val inhabitant).
Canonical Structure stateC := leibnizC state.
Canonical Structure valC := leibnizC val.
......@@ -336,10 +372,10 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
| AppLCtx v2 => App e (of_val v2)
| AppRCtx e1 => App e1 e
| UnOpCtx op => UnOp op e
| BinOpLCtx op v2 => BinOp op e (of_val v2)
| BinOpLCtx op v2 => BinOp op e (Val v2)
| BinOpRCtx op e1 => BinOp op e1 e
| IfCtx e1 e2 => If e e1 e2
| PairLCtx v2 => Pair e (of_val v2)
| PairLCtx v2 => Pair e (Val v2)
| PairRCtx e1 => Pair e1 e
| FstCtx => Fst e
| SndCtx => Snd e
......@@ -348,46 +384,46 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
| CaseCtx e1 e2 => Case e e1 e2
| AllocCtx => Alloc e
| LoadCtx => Load e
| StoreLCtx v2 => Store e (of_val v2)
| StoreLCtx v2 => Store e (Val v2)
| StoreRCtx e1 => Store e1 e
| CasLCtx v1 v2 => CAS e (of_val v1) (of_val v2)
| CasMCtx e0 v2 => CAS e0 e (of_val v2)
| CasLCtx v1 v2 => CAS e (Val v1) (Val v2)
| CasMCtx e0 v2 => CAS e0 e (Val v2)
| CasRCtx e0 e1 => CAS e0 e1 e
| FaaLCtx v2 => FAA e (of_val v2)
| FaaLCtx v2 => FAA e (Val v2)
| FaaRCtx e1 => FAA e1 e
| ProphLCtx v2 => ResolveProph e (of_val v2)
| ProphRCtx e1 => ResolveProph e1 e
end.
(** Substitution *)
Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
Fixpoint subst (x : string) (v : val) (e : expr) : expr :=
match e with
| Var y => if decide (x = y) then es else Var y
| Val _ => e
| Var y => if decide (x = y) then Val v else Var y
| Rec f y e =>
Rec f y $ if decide (BNamed x f BNamed x y) then subst x es e else e
| App e1 e2 => App (subst x es e1) (subst x es e2)
| Lit l => Lit l
| UnOp op e => UnOp op (subst x es e)
| BinOp op e1 e2 => BinOp op (subst x es e1) (subst x es e2)
| If e0 e1 e2 => If (subst x es e0) (subst x es e1) (subst x es e2)
| Pair e1 e2 => Pair (subst x es e1) (subst x es e2)
| Fst e => Fst (subst x es e)
| Snd e => Snd (subst x es e)