Finished first iteration of dist language

parent c5ae06a7
Pipeline #6133 failed with stages
in 0 seconds
......@@ -75,6 +75,19 @@ theories/heap_lang/lib/ticket_lock.v
theories/heap_lang/lib/counter.v
theories/heap_lang/proofmode.v
theories/heap_lang/adequacy.v
theories/dist_lang/lang.v
theories/dist_lang/tactics.v
theories/dist_lang/lifting.v
theories/dist_lang/notation.v
theories/dist_lang/lib/spawn.v
theories/dist_lang/lib/par.v
theories/dist_lang/lib/assert.v
theories/dist_lang/lib/lock.v
theories/dist_lang/lib/spin_lock.v
theories/dist_lang/lib/ticket_lock.v
theories/dist_lang/lib/counter.v
theories/dist_lang/proofmode.v
theories/dist_lang/adequacy.v
theories/proofmode/base.v
theories/proofmode/tokens.v
theories/proofmode/coq_tactics.v
......
From iris.program_logic Require Export weakestpre adequacy.
From iris.heap_lang Require Export lifting.
From iris.dist_lang Require Export lifting.
From iris.algebra Require Import auth.
From iris.heap_lang Require Import proofmode notation.
From iris.proofmode Require Import tactics.
......
......@@ -533,19 +533,113 @@ Inductive head_step' : expr → state' → expr → state' → list (expr) → P
σc !! l = Some (Buffer [] r')
head_step' (Recv (Lit $ LitChan l Right)) σ (Recv (Lit $ LitChan l Right)) σ [].
(* Process extension *)
Definition processes := gmap loc heap.
Definition state'' := prod processes channels.
Inductive pexpr := PExpr (l : loc) (e : expr).
Inductive pval := PVal (l: loc) (v : val).
(* Inductive pexpr := PExpr (l : loc) (e : expr). *)
Definition pexpr := prod loc expr.
Definition pexpr_to_expr (pe : pexpr) : expr := pe.2.
(* Definition lift_expr (i : loc) (e : expr) : pexpr := PExpr i e. *)
(* Inductive pval := PVal (l: loc) (v : val). *)
Definition pval := prod loc val.
Definition pval_to_val (pv : pval) : val := pv.2.
Definition unpack_expr (e:pexpr) : expr :=
match e with
| PExpr i e => e
Definition of_val'' (v : pval) : pexpr := (v.1, of_val (pval_to_val v)).
Definition to_val'' (e : pexpr) : option pval :=
match to_val (pexpr_to_expr e) with
| Some v => Some (e.1, v)
| None => None
end.
(* Lemma to_val_val'' e : option_map (pval_to_val) (to_val'' e) = to_val (pexpr_to_expr e). *)
(* Proof. *)
(* unfold to_val''. *)
(* destruct (to_val (pexpr_to_expr e)); reflexivity. *)
(* Qed. *)
(* Lemma to_val_val''' e : is_Some (to_val'' e) = is_Some (to_val (pexpr_to_expr e)). *)
(* Proof. *)
(* destruct e. *)
(* unfold to_val''. *)
(* simpl. *)
(* destruct (to_val e). *)
(* - admit. *)
(* - apply is_Some_alt (@None A). *)
(* assert(is_Some (Some (l,v)) = True). apply <- is_Some_dec. rewrite <- is_Some_alt. eq_dec. apply is_Some_alt. *)
(* exists (x := x'). reflexivity. *)
Lemma to_val_val'' e : is_Some (to_val (pexpr_to_expr e)) is_Some (to_val'' e) .
Proof.
split.
- intros.
unfold to_val''.
simpl.
inversion H.
rewrite H0.
eauto.
- unfold to_val''.
simpl.
intros.
inversion H.
destruct (to_val (pexpr_to_expr e)).
+ eauto.
+ inversion H0.
Qed.
Lemma to_val_val''_none e : to_val (pexpr_to_expr e) = None to_val'' e = None.
Proof.
unfold to_val''; destruct (to_val (pexpr_to_expr e)); split; intros; inversion H; reflexivity.
Qed.
Lemma to_of_val'' v : to_val'' (of_val'' v) = Some v.
Proof.
destruct v. unfold to_val''. unfold of_val''. simpl. rewrite to_of_val. reflexivity.
Qed.
(* Lemma prod_eq a a' b b' : a = a' → b = b' → (a,b) = (a',b'). *)
(* Proof. *)
Lemma of_to_val'' e v : to_val'' e = Some v of_val'' v = e.
Proof.
destruct e, v.
unfold to_val'', of_val''.
simpl.
intros.
assert (to_val e = Some v). remember (to_val e) as tve. destruct tve in *. inversion H. subst. reflexivity. inversion H.
assert (l = l0). destruct (to_val e). simplify_option_eq. reflexivity. inversion H.
subst.
simplify_option_eq.
apply injective_projections; simpl.
- reflexivity.
- generalize dependent H0. apply of_to_val.
Qed.
Instance of_val_inj'' : Inj (=) (=) of_val''.
Proof. by intros ?? Hv; apply (inj Some); rewrite -!to_of_val'' Hv. Qed.
Definition fill_item'' (Ki : ectx_item) (e : pexpr) : pexpr := (e.1, fill_item Ki e.2).
Lemma fill_item_item'' Ki e : fill_item Ki (pexpr_to_expr e) = pexpr_to_expr (fill_item'' Ki e).
Proof.
unfold pexpr_to_expr.
simpl.
reflexivity.
Qed.
(* Definition lift_expr (i : loc) (e : expr) : pexpr := PExpr i e. *)
Definition unpack_expr (e:pexpr) : expr := snd e.
(* match e with *)
(* | PExpr i e => e *)
(* end. *)
(* Definition unpack_state (s:processes) (i:loc) : heap := *)
(* match s !! i with *)
(* | Some(h) => h *)
......@@ -554,43 +648,73 @@ Definition unpack_expr (e:pexpr) : expr :=
(*Definition lift_expr (i : nat) (e : expr) : expr := Expr i e.*)
(* Fixpoint forPairs (i : loc) (pes : list pexpr) (es : list expr) : Prop := *)
(* match (pes, es) with *)
(* | (pe::pes, e::es) => pe = PExpr i e /\ forPairs i pes es *)
(* | ([],[]) => True *)
(* | (_,_) => False *)
(* end. *)
Fixpoint forPairs (i : loc) (pes : list pexpr) (es : list expr) : Prop :=
match (pes, es) with
| (pe::pes, e::es) => pe = PExpr i e /\ forPairs i pes es
| (pe::pes, e::es) => pe = (i, e) /\ forPairs i pes es
| ([],[]) => True
| (_,_) => False
end.
Inductive head_step'' : pexpr state'' pexpr state'' list (pexpr) Prop :=
| ExprS' p pe pσ pσs pσc e σ
pe' pσ' pσs' pσc' e' σ'
(* | ExprS'' p pe pσ pσs pσc e σ *)
(* pe' pσ' pσs' pσc' e' σ' *)
(* pes es : *)
(* (* pe = PExpr p e → *) *)
(* pe = (p, e) → *)
(* fst pσ = pσs → *)
(* snd pσ = pσc → *)
(* pσs !! p = Some(σ) → *)
(* (* pe' = PExpr p e' → *) *)
(* pe' = (p, e') → *)
(* fst pσ' = pσs' → *)
(* snd pσ' = pσc' → *)
(* pσs' !! p = Some(σ') → *)
(* forPairs p pes es → *)
(* head_step' e (σ,pσc) e' (σ',pσc') es → *)
(* head_step'' pe pσ pe' pσ' pes *)
| ExprS' p pσs pσc e σ
pσs' pσc' e' σ'
pes es :
pe = PExpr p e
fst pσ = pσs
snd pσ = pσc
pσs !! p = Some(σ)
pe' = PExpr p e'
fst pσ' = pσs'
snd pσ' = pσc'
pσs !! p = Some(σ)
pσs' !! p = Some(σ')
forPairs p pes es
head_step' e (σ,pσc) e' (σ',pσc') es
head_step'' pe pσ pe' pσ' pes
head_step'' (p,e) (pσs, pσc) (p,e') (pσs', pσc') pes
| StartS p e σ σp σc p' v :
fst σ = σp
snd σ = σc
σp !! p' = None
to_val e = Some $ v
head_step'' (PExpr p (Start e)) σ (PExpr p (Lit $ LitUnit)) (<[p':=]>σp, σc) [PExpr p' e].
(* head_step'' (PExpr p (Start e)) σ (PExpr p (Lit $ LitUnit)) (<[p':=∅]>σp, σc) [PExpr p' e]. *)
head_step'' (p, (Start e)) σ (p, (Lit $ LitUnit)) (<[p':=]>σp, σc) [(p', e)].
(** Basic properties about the language *)
Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki).
Proof. destruct Ki; intros ???; simplify_eq/=; auto with f_equal. Qed.
Instance fill_item_inj'' Ki : Inj (=) (=) (fill_item'' Ki).
Proof.
unfold fill_item''. intros ???. inversion H. destruct x, y. apply injective_projections; simpl in *.
- subst. reflexivity.
- generalize dependent H2. apply fill_item_inj.
Qed.
Lemma fill_item_val Ki e :
is_Some (to_val (fill_item Ki e)) is_Some (to_val e).
Proof. intros [v ?]. destruct Ki; simplify_option_eq; eauto. Qed.
Lemma fill_item_val'' Ki e :
is_Some (to_val'' (fill_item'' Ki e)) is_Some (to_val'' e).
Proof. intros. apply to_val_val'' in H. apply to_val_val''. destruct e. simpl in *. generalize dependent H.
apply fill_item_val. Qed.
Lemma val_head_stuck e1 σ1 e2 σ2 efs : head_step e1 σ1 e2 σ2 efs to_val e1 = None.
Proof. destruct 1; naive_solver. Qed.
......@@ -599,10 +723,9 @@ Proof.
destruct 1; try naive_solver. generalize H1. apply val_head_stuck.
Qed.
Lemma val_head_stuck'' e1 σ1 e2 σ2 efs : head_step'' e1 σ1 e2 σ2 efs to_val (unpack_expr e1) = None.
Lemma val_head_stuck'' e1 σ1 e2 σ2 efs : head_step'' e1 σ1 e2 σ2 efs to_val'' e1 = None.
Proof.
destruct 1; try naive_solver. rewrite H. simpl. generalize H8. apply val_head_stuck'.
Qed.
destruct 1; try naive_solver. apply val_head_stuck' in H2. unfold to_val''. subst. simpl. rewrite H2. reflexivity. Qed.
Lemma head_ctx_step_val Ki e σ1 e2 σ2 efs :
head_step (fill_item Ki e) σ1 e2 σ2 efs is_Some (to_val e).
......@@ -616,12 +739,12 @@ Proof.
repeat (generalize dependent H; destruct Ki; inversion_clear 1; simplify_option_eq; by eauto).
Qed.
Lemma head_ctx_step_val'' Ki p e σ1 e2 σ2 efs :
head_step'' (PExpr p (fill_item Ki e)) σ1 e2 σ2 efs is_Some (to_val e).
Lemma head_ctx_step_val'' Ki e σ1 e2 σ2 efs :
head_step'' (fill_item'' Ki e) σ1 e2 σ2 efs is_Some (to_val'' e).
Proof.
inversion 1;
first (generalize dependent H9; subst; assert (e0 = fill_item Ki e) by (by inversion H0); rewrite H1; apply head_ctx_step_val');
repeat (generalize dependent H; destruct Ki; inversion_clear 1; simplify_option_eq; by eauto).
inversion 1.
- apply to_val_val''. generalize dependent H9. apply head_ctx_step_val'.
- apply to_val_val''. generalize dependent H; destruct Ki; inversion_clear 1; unfold pexpr_to_expr; simplify_option_eq; by eauto.
Qed.
Lemma fill_item_no_val_inj Ki1 Ki2 e1 e2 :
......@@ -634,11 +757,31 @@ Proof.
end; auto.
Qed.
Lemma fill_item_no_val_inj'' Ki1 Ki2 e1 e2 :
to_val'' e1 = None to_val'' e2 = None
fill_item'' Ki1 e1 = fill_item'' Ki2 e2 Ki1 = Ki2.
Proof.
intros.
apply to_val_val''_none in H.
apply to_val_val''_none in H0.
unfold fill_item'' in H1.
inversion H1.
generalize dependent H4.
generalize dependent H0.
generalize dependent H.
apply fill_item_no_val_inj.
Qed.
Lemma alloc_fresh e v σ :
let l := fresh (dom (gset loc) σ) in
to_val e = Some v head_step (Alloc e) σ (Lit (LitLoc l)) (<[l:=v]>σ) [].
Proof. by intros; apply AllocS, (not_elem_of_dom (D:=gset loc)), is_fresh. Qed.
Lemma alloc_fresh' σ σs σc :
let l := fresh (dom (gset loc) σc) in
fst σ = σs snd σ = σc head_step' NewChan σ (Pair (Lit $ LitChan l Left) (Lit $ LitChan l Right)) (σs, <[l:=Buffer [] []]>σc) [].
Proof. by intros; apply NewChanS, (not_elem_of_dom (D:=gset loc)), is_fresh. Qed.
(* Misc *)
Lemma to_val_rec f x e `{!Closed (f :b: x :b: []) e} :
to_val (Rec f x e) = Some (RecV f x e).
......@@ -716,6 +859,19 @@ Proof.
split; apply _ || eauto using to_of_val, of_to_val, val_head_stuck,
fill_item_val, fill_item_no_val_inj, head_ctx_step_val.
Qed.
Lemma dist_lang_mixin' : EctxiLanguageMixin of_val to_val fill_item head_step'.
Proof.
split; apply _ || eauto using to_of_val, of_to_val, val_head_stuck',
fill_item_val, fill_item_no_val_inj, head_ctx_step_val'.
Qed.
Lemma dist_lang_mixin'' : EctxiLanguageMixin of_val'' to_val'' fill_item'' head_step''.
Proof.
split; apply _ || eauto using to_of_val'', of_to_val'', val_head_stuck'',
fill_item_val'', fill_item_no_val_inj'', head_ctx_step_val''.
Qed.
End dist_lang.
(** Language *)
......@@ -723,6 +879,16 @@ Canonical Structure dist_ectxi_lang := EctxiLanguage dist_lang.dist_lang_mixin.
Canonical Structure dist_ectx_lang := EctxLanguageOfEctxi dist_ectxi_lang.
Canonical Structure dist_lang := LanguageOfEctx dist_ectx_lang.
(** Language' *)
Canonical Structure dist_ectxi_lang' := EctxiLanguage dist_lang.dist_lang_mixin'.
Canonical Structure dist_ectx_lang' := EctxLanguageOfEctxi dist_ectxi_lang'.
Canonical Structure dist_lang' := LanguageOfEctx dist_ectx_lang'.
(** Language'' *)
Canonical Structure dist_ectxi_lang'' := EctxiLanguage dist_lang.dist_lang_mixin''.
Canonical Structure dist_ectx_lang'' := EctxLanguageOfEctxi dist_ectxi_lang''.
Canonical Structure dist_lang'' := LanguageOfEctx dist_ectx_lang''.
(* Prefer dist_lang names over ectx_language names. *)
Export dist_lang.
......
From iris.program_logic Require Export language ectx_language ectxi_language.
From iris.algebra Require Export ofe.
From stdpp Require Export strings.
From stdpp Require Import gmap.
Set Default Proof Using "Type".
Module heap_lang.
Open Scope Z_scope.
(** Expressions and vals. *)
Definition loc := positive. (* Really, any countable type. *)
Inductive base_lit : Set :=
| LitInt (n : Z) | LitBool (b : bool) | LitUnit | LitLoc (l : loc) | LitChan (c : nat).
Inductive un_op : Set :=
| NegOp | MinusUnOp.
Inductive bin_op : Set :=
| PlusOp | MinusOp | MultOp | QuotOp | RemOp (* Arithmetic *)
| AndOp | OrOp | XorOp (* Bitwise *)
| ShiftLOp | ShiftROp (* Shifts *)
| LeOp | LtOp | EqOp. (* Relations *)
Inductive binder := BAnon | BNamed : string binder.
Delimit Scope binder_scope with bind.
Bind Scope binder_scope with binder.
Definition cons_binder (mx : binder) (X : list string) : list string :=
match mx with BAnon => X | BNamed x => x :: X end.
Infix ":b:" := cons_binder (at level 60, right associativity).
Instance binder_eq_dec_eq : EqDecision binder.
Proof. solve_decision. Defined.
Instance set_unfold_cons_binder x mx X P :
SetUnfold (x X) P SetUnfold (x mx :b: X) (BNamed x = mx P).
Proof.
constructor. rewrite -(set_unfold (x X) P).
destruct mx; rewrite /= ?elem_of_cons; naive_solver.
Qed.
Inductive iExpr :=
(* 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)
(* Products *)
| Pair (e1 e2 : expr)
| Fst (e : expr)
| Snd (e : expr)
(* Sums *)
| InjL (e : expr)
| InjR (e : expr)
| Case (e0 : expr) (e1 : expr) (e2 : expr)
(* Concurrency *)
| Fork (e : expr)
(* Heap *)
| Alloc (e : expr)
| Load (e : expr)
| Store (e1 : expr) (e2 : expr)
| CAS (e0 : expr) (e1 : expr) (e2 : expr)
| FAA (e1 : expr) (e2 : expr)
(* Process *)
| Start (e : expr)
| NewChan
(*| Send (e c : expr)
| Recv (c : expr)*)
with expr := Expr (i : nat) (e : iExpr).
Bind Scope expr_scope with expr.
Fixpoint is_closed (X : list string) (e : expr) : bool :=
match e with
| Expr i e => match e with
| Var x => bool_decide (x X)
| Rec f x e => is_closed (f :b: x :b: X) e
| Lit _ | NewChan => true
| UnOp _ e | Fst e | Snd e | InjL e | InjR e | Fork e | Alloc e | Load e | Start e (*| Recv e*) =>
is_closed X e
| App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 | FAA e1 e2 (*| Send 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
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 iVal :=
| RecV (f x : binder) (e : expr) `{!Closed (f :b: x :b: []) e} (* This is a restriction *)
| LitV (l : base_lit)
| PairV (v1 v2 : val)
| InjLV (v : val)
| InjRV (v : val)
with val := Val (i : nat) (v : iVal).
Bind Scope val_scope with val.
Fixpoint of_val (v : val) : expr :=
match v with
| Val i v => Expr i (of_iVal v)
end
with of_iVal (v : iVal) : iExpr :=
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.
Fixpoint to_val (e : expr) : option val :=
match e with
| Expr i e => match (to_iVal e) with
| Some v => Some $ Val i v
| None => None
end
end
with to_iVal (e : iExpr) : option iVal :=
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
| _ => None
end.
(** The state: heaps of vals. *)
Definition heap := gmap loc val.
Definition state := gmap nat heap.
(*
(** 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.
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.
Instance of_val_inj : Inj (=) (=) of_val.
Proof. by intros ?? Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed.
Instance base_lit_eq_dec : EqDecision base_lit.
Proof. solve_decision. Defined.
Instance un_op_eq_dec : EqDecision un_op.
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.
Defined.
Instance base_lit_countable : Countable base_lit.
Proof.
refine (inj_countable' (λ l, match l with
| LitInt n => inl (inl (inl n)) | LitBool b => inl (inl (inr b))
| LitUnit => inl (inr (inl ())) | LitLoc l => inl (inr (inr l))
| LitChan c => inr (c) (* Correct? *)
end) (λ l, match l with
| inl (inl (inl n)) => LitInt n | inl (inl (inr b)) => LitBool b
| inl (inr (inl ())) => LitUnit | inl (inr (inr l)) => LitLoc l
| inr (c) => LitChan c (* Correct? *)
end) _); by intros [].
Qed.
Instance un_op_finite : Countable un_op.
Proof.
refine (inj_countable' (λ op, match op with NegOp => 0 | MinusUnOp => 1 end)
(λ n, match n with 0 => NegOp | _ => MinusUnOp end) _); by intros [].
Qed.
Instance bin_op_countable : Countable bin_op.
Proof.
refine (inj_countable' (λ op, match op with
| PlusOp => 0 | MinusOp => 1 | MultOp => 2 | QuotOp => 3 | RemOp => 4
| AndOp => 5 | OrOp => 6 | XorOp => 7 | ShiftLOp => 8 | ShiftROp => 9
| LeOp => 10 | LtOp => 11 | EqOp => 12
end) (λ n, match n with
| 0 => PlusOp | 1 => MinusOp | 2 => MultOp | 3 => QuotOp | 4 => RemOp
| 5 => AndOp | 6 => OrOp | 7 => XorOp | 8 => ShiftLOp | 9 => ShiftROp
| 10 => LeOp | 11 => LtOp | _ => EqOp
end) _); by intros [].
Qed.
Instance binder_countable : Countable binder.
Proof.
refine (inj_countable' (λ b, match b with BNamed s => Some s | BAnon => None end)
(λ b, match b with Some s => BNamed s | None => BAnon end) _); by intros [].
Qed.
Instance expr_countable : Countable expr.
Proof.
set (enc := fix go e :=
match e with
| Var x => GenLeaf (inl (inl x))
| Rec f x e => GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); go e]
| App e1 e2 => GenNode 1 [go e1; go e2]
| Lit l => GenLeaf (inr (inl l))
| UnOp op e => GenNode 2 [GenLeaf (inr (inr (inl op))); go e]
| BinOp op e1 e2 => GenNode 3 [GenLeaf (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]
| Start e => GenNode 17 [go e] (* Added *)
end).
set (dec := fix go e :=
match e with
| GenLeaf (inl (inl x)) => Var x
| GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); e] => Rec f x (go e)
| GenNode 1 [e1; e2] => App (go e1) (go e2)
| GenLeaf (inr (inl l)) => Lit l
| GenNode 2 [GenLeaf (inr (inr (inl op))); e] => UnOp op (go e)
| GenNode 3 [GenLeaf (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)
| GenNode 17 [e] => Start (go e) (* Added *)
| _ => Lit LitUnit (* dummy *)
end).
refine (inj_countable' enc dec _). intros e. induction e; f_equal/=; auto.
Qed.
Instance val_countable : Countable val.
Proof. refine (inj_countable of_val to_val _); auto using to_of_val. Qed.
Instance expr_inhabited : Inhabited expr := populate (Lit LitUnit).
Instance val_inhabited : Inhabited val := populate (LitV LitUnit).
Canonical Structure stateC := leibnizC state.