|
|
From iris.prelude Require Import prelude.
|
|
|
From stdpp Require Export binders strings.
|
|
|
From semantics.ts.systemf_mu_state Require Export locations.
|
|
|
From semantics.lib Require Export maps.
|
|
|
|
|
|
Declare Scope expr_scope.
|
|
|
Declare Scope val_scope.
|
|
|
Delimit Scope expr_scope with E.
|
|
|
Delimit Scope val_scope with V.
|
|
|
|
|
|
(** Expressions and vals. *)
|
|
|
Inductive base_lit : Set :=
|
|
|
| LitInt (n : Z) | LitBool (b : bool) | LitUnit | LitLoc (l : loc).
|
|
|
Inductive un_op : Set :=
|
|
|
| NegOp | MinusUnOp.
|
|
|
Inductive bin_op : Set :=
|
|
|
| PlusOp | MinusOp | MultOp (* Arithmetic *)
|
|
|
| LtOp | LeOp | EqOp. (* Comparison *)
|
|
|
|
|
|
|
|
|
Inductive expr :=
|
|
|
| Lit (l : base_lit)
|
|
|
(* Base lambda calculus *)
|
|
|
| Var (x : string)
|
|
|
| Lam (x : binder) (e : expr)
|
|
|
| App (e1 e2 : expr)
|
|
|
(* Base types and their operations *)
|
|
|
| UnOp (op : un_op) (e : expr)
|
|
|
| BinOp (op : bin_op) (e1 e2 : expr)
|
|
|
| If (e0 e1 e2 : expr)
|
|
|
(* Polymorphism *)
|
|
|
| TApp (e : expr)
|
|
|
| TLam (e : expr)
|
|
|
| Pack (e : expr)
|
|
|
| Unpack (x : binder) (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)
|
|
|
(* Isorecursive types *)
|
|
|
| Roll (e : expr)
|
|
|
| Unroll (e : expr)
|
|
|
(* State *)
|
|
|
| Load (e : expr)
|
|
|
| Store (e1 e2 : expr)
|
|
|
| New (e : expr)
|
|
|
.
|
|
|
|
|
|
Bind Scope expr_scope with expr.
|
|
|
|
|
|
Inductive val :=
|
|
|
| LitV (l : base_lit)
|
|
|
| LamV (x : binder) (e : expr)
|
|
|
| TLamV (e : expr)
|
|
|
| PackV (v : val)
|
|
|
| PairV (v1 v2 : val)
|
|
|
| InjLV (v : val)
|
|
|
| InjRV (v : val)
|
|
|
| RollV (v : val)
|
|
|
.
|
|
|
|
|
|
Bind Scope val_scope with val.
|
|
|
|
|
|
Fixpoint of_val (v : val) : expr :=
|
|
|
match v with
|
|
|
| LitV l => Lit l
|
|
|
| LamV x e => Lam x e
|
|
|
| TLamV e => TLam e
|
|
|
| PackV v => Pack (of_val v)
|
|
|
| PairV v1 v2 => Pair (of_val v1) (of_val v2)
|
|
|
| InjLV v => InjL (of_val v)
|
|
|
| InjRV v => InjR (of_val v)
|
|
|
| RollV v => Roll (of_val v)
|
|
|
end.
|
|
|
|
|
|
Fixpoint to_val (e : expr) : option val :=
|
|
|
match e with
|
|
|
| Lit l => Some $ LitV l
|
|
|
| Lam x e => Some (LamV x e)
|
|
|
| TLam e => Some (TLamV e)
|
|
|
| Pack e =>
|
|
|
to_val e ≫= (λ v, Some $ PackV v)
|
|
|
| Pair e1 e2 =>
|
|
|
to_val e1 ≫= (λ v1, to_val e2 ≫= (λ v2, Some $ PairV v1 v2))
|
|
|
| InjL e => to_val e ≫= (λ v, Some $ InjLV v)
|
|
|
| InjR e => to_val e ≫= (λ v, Some $ InjRV v)
|
|
|
| Roll e => to_val e ≫= (λ v, Some $ RollV v)
|
|
|
| _ => None
|
|
|
end.
|
|
|
|
|
|
(** 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.
|
|
|
|
|
|
#[export] Instance of_val_inj : Inj (=) (=) of_val.
|
|
|
Proof. by intros ?? Hv; apply (inj Some); rewrite <-!to_of_val, Hv. Qed.
|
|
|
|
|
|
(** structural computational version *)
|
|
|
Fixpoint is_val (e : expr) : Prop :=
|
|
|
match e with
|
|
|
| Lit l => True
|
|
|
| Lam x e => True
|
|
|
| TLam e => True
|
|
|
| Pack e => is_val e
|
|
|
| Pair e1 e2 => is_val e1 ∧ is_val e2
|
|
|
| InjL e => is_val e
|
|
|
| InjR e => is_val e
|
|
|
| Roll e => is_val e
|
|
|
| _ => False
|
|
|
end.
|
|
|
Lemma is_val_spec e : is_val e ↔ ∃ v, to_val e = Some v.
|
|
|
Proof.
|
|
|
induction e as [ | | ? e IH | e1 IH1 e2 IH2 | e IH | ? e1 IH1 e2 IH2 | e1 IH1 e2 IH2 e3 IH3 | e IH | e IH | e IH | ? e1 IH1 e2 IH2 | e1 IH1 e2 IH2 | e IH | e IH | e IH | e IH | e1 IH1 e2 IH2 e3 IH3 | e IH | e IH | | | ];
|
|
|
simpl; (split; [ | intros (v & Heq)]); simplify_option_eq; try naive_solver.
|
|
|
- rewrite IH. intros (v & ->). eauto.
|
|
|
- rewrite IH1 IH2. intros [(v1 & ->) (v2 & ->)]. eauto.
|
|
|
- rewrite IH. intros (v & ->). eauto.
|
|
|
- rewrite IH. intros (v & ->); eauto.
|
|
|
- rewrite IH. intros (v & ->). eauto.
|
|
|
Qed.
|
|
|
|
|
|
Global Instance base_lit_eq_dec : EqDecision base_lit.
|
|
|
Proof. solve_decision. Defined.
|
|
|
Global Instance un_op_eq_dec : EqDecision un_op.
|
|
|
Proof. solve_decision. Defined.
|
|
|
Global Instance bin_op_eq_dec : EqDecision bin_op.
|
|
|
Proof. solve_decision. Defined.
|
|
|
|
|
|
|
|
|
(** Substitution *)
|
|
|
Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
|
|
|
match e with
|
|
|
| Lit _ => e
|
|
|
| Var y => if decide (x = y) then es else Var y
|
|
|
| Lam y e =>
|
|
|
Lam y $ if decide (BNamed x = y) then e else subst x es e
|
|
|
| App e1 e2 => App (subst x es e1) (subst x es e2)
|
|
|
| TApp e => TApp (subst x es e)
|
|
|
| TLam e => TLam (subst x es e)
|
|
|
| Pack e => Pack (subst x es e)
|
|
|
| Unpack y e1 e2 => Unpack y (subst x es e1) (if decide (BNamed x = y) then e2 else subst x es e2)
|
|
|
| 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)
|
|
|
| InjL e => InjL (subst x es e)
|
|
|
| InjR e => InjR (subst x es e)
|
|
|
| Case e0 e1 e2 => Case (subst x es e0) (subst x es e1) (subst x es e2)
|
|
|
| Roll e => Roll (subst x es e)
|
|
|
| Unroll e => Unroll (subst x es e)
|
|
|
| Load e => Load (subst x es e)
|
|
|
| Store e1 e2 => Store (subst x es e1) (subst x es e2)
|
|
|
| New e => New (subst x es e)
|
|
|
end.
|
|
|
|
|
|
Definition subst' (mx : binder) (es : expr) : expr → expr :=
|
|
|
match mx with BNamed x => subst x es | BAnon => id end.
|
|
|
|
|
|
(** The stepping relation *)
|
|
|
Definition un_op_eval (op : un_op) (v : val) : option val :=
|
|
|
match op, v with
|
|
|
| NegOp, LitV (LitBool b) => Some $ LitV $ LitBool (negb b)
|
|
|
| MinusUnOp, LitV (LitInt n) => Some $ LitV $ LitInt (- n)
|
|
|
| _, _ => None
|
|
|
end.
|
|
|
|
|
|
Definition bin_op_eval_int (op : bin_op) (n1 n2 : Z) : option base_lit :=
|
|
|
match op with
|
|
|
| PlusOp => Some $ LitInt (n1 + n2)
|
|
|
| MinusOp => Some $ LitInt (n1 - n2)
|
|
|
| MultOp => Some $ LitInt (n1 * n2)
|
|
|
| LtOp => Some $ LitBool (bool_decide (n1 < n2))
|
|
|
| LeOp => Some $ LitBool (bool_decide (n1 ≤ n2))
|
|
|
| EqOp => Some $ LitBool (bool_decide (n1 = n2))
|
|
|
end%Z.
|
|
|
|
|
|
Definition bin_op_eval (op : bin_op) (v1 v2 : val) : option val :=
|
|
|
match v1, v2 with
|
|
|
| LitV (LitInt n1), LitV (LitInt n2) => LitV <$> bin_op_eval_int op n1 n2
|
|
|
| _, _ => None
|
|
|
end.
|
|
|
|
|
|
Definition heap := gmap loc val.
|
|
|
Fixpoint heap_array (l : loc) (vs : list val) : heap :=
|
|
|
match vs with
|
|
|
| [] => ∅
|
|
|
| v :: vs' => {[l := v]} ∪ heap_array (l +ₗ 1) vs'
|
|
|
end.
|
|
|
|
|
|
Lemma heap_array_singleton l v : heap_array l [v] = {[l := v]}.
|
|
|
Proof. by rewrite /heap_array right_id. Qed.
|
|
|
|
|
|
Lemma heap_array_lookup l vs w k :
|
|
|
heap_array l vs !! k = Some w ↔
|
|
|
∃ j, (0 ≤ j)%Z ∧ k = l +ₗ j ∧ vs !! (Z.to_nat j) = Some w.
|
|
|
Proof.
|
|
|
revert k l; induction vs as [|v' vs IH]=> l' l /=.
|
|
|
{ rewrite lookup_empty. naive_solver lia. }
|
|
|
rewrite -insert_union_singleton_l lookup_insert_Some IH. split.
|
|
|
- intros [[-> ?] | (Hl & j & ? & -> & ?)].
|
|
|
{ eexists 0. rewrite loc_add_0. naive_solver lia. }
|
|
|
eexists (1 + j)%Z. rewrite loc_add_assoc !Z.add_1_l Z2Nat.inj_succ; eauto with lia.
|
|
|
- intros (j & ? & -> & Hil). destruct (decide (j = 0)); simplify_eq/=.
|
|
|
{ rewrite loc_add_0. eauto. }
|
|
|
right. split.
|
|
|
{ rewrite -{1}(loc_add_0 l). intros ?%(inj (loc_add _)); lia. }
|
|
|
assert (Z.to_nat j = S (Z.to_nat (j - 1))) as Hj.
|
|
|
{ rewrite -Z2Nat.inj_succ; last lia. f_equal; lia. }
|
|
|
rewrite Hj /= in Hil.
|
|
|
eexists (j - 1)%Z. rewrite loc_add_assoc Z.add_sub_assoc Z.add_simpl_l.
|
|
|
auto with lia.
|
|
|
Qed.
|
|
|
|
|
|
Lemma heap_array_map_disjoint (h : heap) (l : loc) (vs : list val) :
|
|
|
(∀ i, (0 ≤ i)%Z → (i < length vs)%Z → h !! (l +ₗ i) = None) →
|
|
|
(heap_array l vs) ##ₘ h.
|
|
|
Proof.
|
|
|
intros Hdisj. apply map_disjoint_spec=> l' v1 v2.
|
|
|
intros (j&?&->&Hj%lookup_lt_Some%inj_lt)%heap_array_lookup.
|
|
|
move: Hj. rewrite Z2Nat.id // => ?. by rewrite Hdisj.
|
|
|
Qed.
|
|
|
|
|
|
Definition init_heap (l : loc) (n : Z) (v : val) (σ : heap) : heap :=
|
|
|
heap_array l (replicate (Z.to_nat n) v) ∪ σ.
|
|
|
|
|
|
Lemma init_heap_singleton l v σ :
|
|
|
init_heap l 1 v σ = <[l:=v]> σ.
|
|
|
Proof.
|
|
|
rewrite /init_heap /=.
|
|
|
rewrite right_id insert_union_singleton_l. done.
|
|
|
Qed.
|
|
|
|
|
|
Inductive base_step : expr * heap → expr * heap → Prop :=
|
|
|
| BetaS x e1 e2 e' σ :
|
|
|
is_val e2 →
|
|
|
e' = subst' x e2 e1 →
|
|
|
base_step (App (Lam x e1) e2, σ) (e', σ)
|
|
|
| TBetaS e1 σ :
|
|
|
base_step (TApp (TLam e1), σ) (e1, σ)
|
|
|
| UnpackS e1 e2 e' x σ :
|
|
|
is_val e1 →
|
|
|
e' = subst' x e1 e2 →
|
|
|
base_step (Unpack x (Pack e1) e2, σ) (e', σ)
|
|
|
| UnOpS op e v v' σ :
|
|
|
to_val e = Some v →
|
|
|
un_op_eval op v = Some v' →
|
|
|
base_step (UnOp op e, σ) (of_val v', σ)
|
|
|
| BinOpS op e1 v1 e2 v2 v' σ :
|
|
|
to_val e1 = Some v1 →
|
|
|
to_val e2 = Some v2 →
|
|
|
bin_op_eval op v1 v2 = Some v' →
|
|
|
base_step (BinOp op e1 e2, σ) (of_val v', σ)
|
|
|
| IfTrueS e1 e2 σ :
|
|
|
base_step (If (Lit $ LitBool true) e1 e2, σ) (e1, σ)
|
|
|
| IfFalseS e1 e2 σ :
|
|
|
base_step (If (Lit $ LitBool false) e1 e2, σ) (e2, σ)
|
|
|
| FstS e1 e2 σ :
|
|
|
is_val e1 →
|
|
|
is_val e2 →
|
|
|
base_step (Fst (Pair e1 e2), σ) (e1, σ)
|
|
|
| SndS e1 e2 σ :
|
|
|
is_val e1 →
|
|
|
is_val e2 →
|
|
|
base_step (Snd (Pair e1 e2), σ) (e2, σ)
|
|
|
| CaseLS e e1 e2 σ :
|
|
|
is_val e →
|
|
|
base_step (Case (InjL e) e1 e2, σ) (App e1 e, σ)
|
|
|
| CaseRS e e1 e2 σ :
|
|
|
is_val e →
|
|
|
base_step (Case (InjR e) e1 e2, σ) (App e2 e, σ)
|
|
|
| UnrollS e σ :
|
|
|
is_val e →
|
|
|
base_step (Unroll (Roll e), σ) (e, σ)
|
|
|
| NewS e v σ l :
|
|
|
σ !! l = None →
|
|
|
to_val e = Some v →
|
|
|
base_step (New e, σ) (Lit $ LitLoc l, init_heap l 1 v σ)
|
|
|
| LoadS l v σ :
|
|
|
σ !! l = Some v →
|
|
|
base_step (Load (Lit $ LitLoc l), σ) (of_val v, σ)
|
|
|
| StoreS l v w e2 σ :
|
|
|
σ !! l = Some v →
|
|
|
to_val e2 = Some w →
|
|
|
base_step (Store (Lit $ LitLoc l) e2, σ)
|
|
|
(Lit LitUnit, <[l:=w]> σ)
|
|
|
.
|
|
|
|
|
|
(* Misc *)
|
|
|
Lemma is_val_of_val v : is_val (of_val v).
|
|
|
Proof. apply is_val_spec. rewrite to_of_val. eauto. Qed.
|
|
|
|
|
|
(** If [e1] makes a base step to a value under some state [σ1] then any base
|
|
|
step from [e1] under any other state [σ1'] must necessarily be to a value. *)
|
|
|
Lemma base_step_to_val e1 e2 e2' σ1 σ2 σ2' :
|
|
|
base_step (e1, σ1) (e2, σ2) →
|
|
|
base_step (e1, σ1) (e2', σ2') → is_Some (to_val e2) → is_Some (to_val e2').
|
|
|
Proof. inversion 1; inversion 1; naive_solver. Qed.
|
|
|
|
|
|
Lemma new_fresh v σ :
|
|
|
let l := fresh_locs (dom σ) in
|
|
|
base_step (New (of_val v), σ) (Lit $ LitLoc l, init_heap l 1 v σ).
|
|
|
Proof.
|
|
|
intros.
|
|
|
apply NewS.
|
|
|
- apply (not_elem_of_dom).
|
|
|
rewrite -(loc_add_0 l).
|
|
|
by apply fresh_locs_fresh.
|
|
|
- rewrite to_of_val. eauto.
|
|
|
Qed.
|
|
|
|
|
|
(** We define evaluation contexts *)
|
|
|
Inductive ectx_item :=
|
|
|
| AppLCtx (v2 : val)
|
|
|
| AppRCtx (e1 : expr)
|
|
|
| TAppCtx
|
|
|
| PackCtx
|
|
|
| UnpackCtx (x : binder) (e2 : expr)
|
|
|
| UnOpCtx (op : un_op)
|
|
|
| BinOpLCtx (op : bin_op) (v2 : val)
|
|
|
| BinOpRCtx (op : bin_op) (e1 : expr)
|
|
|
| IfCtx (e1 e2 : expr)
|
|
|
| PairLCtx (v2 : val)
|
|
|
| PairRCtx (e1 : expr)
|
|
|
| FstCtx
|
|
|
| SndCtx
|
|
|
| InjLCtx
|
|
|
| InjRCtx
|
|
|
| CaseCtx (e1 : expr) (e2 : expr)
|
|
|
| UnrollCtx
|
|
|
| RollCtx
|
|
|
| LoadCtx
|
|
|
| StoreRCtx (e1 : expr)
|
|
|
| StoreLCtx (v2 : val)
|
|
|
| NewCtx
|
|
|
.
|
|
|
|
|
|
Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
|
|
|
match Ki with
|
|
|
| AppLCtx v2 => App e (of_val v2)
|
|
|
| AppRCtx e1 => App e1 e
|
|
|
| TAppCtx => TApp e
|
|
|
| PackCtx => Pack e
|
|
|
| UnpackCtx x e2 => Unpack x e e2
|
|
|
| UnOpCtx op => UnOp op e
|
|
|
| BinOpLCtx op v2 => BinOp op e (of_val v2)
|
|
|
| BinOpRCtx op e1 => BinOp op e1 e
|
|
|
| IfCtx e1 e2 => If e e1 e2
|
|
|
| PairLCtx v2 => Pair e (of_val v2)
|
|
|
| PairRCtx e1 => Pair e1 e
|
|
|
| FstCtx => Fst e
|
|
|
| SndCtx => Snd e
|
|
|
| InjLCtx => InjL e
|
|
|
| InjRCtx => InjR e
|
|
|
| CaseCtx e1 e2 => Case e e1 e2
|
|
|
| UnrollCtx => Unroll e
|
|
|
| RollCtx => Roll e
|
|
|
| LoadCtx => Load e
|
|
|
| StoreRCtx e1 => Store e1 e
|
|
|
| StoreLCtx v2 => Store e (of_val v2)
|
|
|
| NewCtx => New e
|
|
|
end.
|
|
|
|
|
|
(** Basic properties about the language *)
|
|
|
Global Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki).
|
|
|
Proof. induction Ki; intros ???; simplify_eq/=; auto with f_equal. Qed.
|
|
|
|
|
|
Lemma fill_item_val Ki e :
|
|
|
is_Some (to_val (fill_item Ki e)) → is_Some (to_val e).
|
|
|
Proof. intros [v ?]. induction Ki; simplify_option_eq; eauto. Qed.
|
|
|
Lemma fill_item_no_val Ki e :
|
|
|
to_val e = None → to_val (fill_item Ki e) = None.
|
|
|
Proof.
|
|
|
intros Hn. destruct (to_val (fill_item _ _ )) eqn:Heq; last done.
|
|
|
edestruct (fill_item_val Ki e) as (? & ?); last simplify_eq.
|
|
|
eauto.
|
|
|
Qed.
|
|
|
|
|
|
Lemma val_base_stuck e1 e2 σ1 σ2 : base_step (e1, σ1) (e2, σ2) → to_val e1 = None.
|
|
|
Proof. inversion 1; naive_solver. Qed.
|
|
|
|
|
|
Lemma of_val_lit v l :
|
|
|
of_val v = (Lit l) → v = LitV l.
|
|
|
Proof. destruct v; simpl; inversion 1; done. Qed.
|
|
|
Lemma of_val_pair_inv (v v1 v2 : val) :
|
|
|
of_val v = Pair (of_val v1) (of_val v2) → v = PairV v1 v2.
|
|
|
Proof.
|
|
|
destruct v; simpl; inversion 1.
|
|
|
apply of_val_inj in H1. apply of_val_inj in H2. subst; done.
|
|
|
Qed.
|
|
|
Lemma of_val_injl_inv (v v' : val) :
|
|
|
of_val v = InjL (of_val v') → v = InjLV v'.
|
|
|
Proof.
|
|
|
destruct v; simpl; inversion 1.
|
|
|
apply of_val_inj in H1. subst; done.
|
|
|
Qed.
|
|
|
Lemma of_val_injr_inv (v v' : val) :
|
|
|
of_val v = InjR (of_val v') → v = InjRV v'.
|
|
|
Proof.
|
|
|
destruct v; simpl; inversion 1.
|
|
|
apply of_val_inj in H1. subst; done.
|
|
|
Qed.
|
|
|
|
|
|
Ltac simplify_val :=
|
|
|
repeat match goal with
|
|
|
| H: to_val (of_val ?v) = ?o |- _ => rewrite to_of_val in H
|
|
|
| H: is_val ?e |- _ => destruct (proj1 (is_val_spec e) H) as (? & ?); clear H
|
|
|
| H: to_val ?e = ?v |- _ => is_var e; specialize (of_to_val _ _ H); intros <-; clear H
|
|
|
| H: of_val ?v = Lit ?l |- _ => is_var v; specialize (of_val_lit _ _ H); intros ->; clear H
|
|
|
| |- context[to_val (of_val ?e)] => rewrite to_of_val
|
|
|
end.
|
|
|
Lemma base_ectxi_step_val Ki e e2 σ1 σ2 :
|
|
|
base_step (fill_item Ki e, σ1) (e2, σ2) → is_Some (to_val e).
|
|
|
Proof.
|
|
|
revert e2. induction Ki; inversion_clear 1; simplify_option_eq; simplify_val; eauto.
|
|
|
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.
|
|
|
revert Ki1. induction Ki2; intros Ki1; induction Ki1; try naive_solver eauto with f_equal.
|
|
|
all: intros ?? Heq; injection Heq; intros ??; simplify_eq; simplify_val; naive_solver.
|
|
|
Qed.
|
|
|
|
|
|
Section contexts.
|
|
|
Notation ectx := (list ectx_item).
|
|
|
Definition empty_ectx : ectx := [].
|
|
|
Definition comp_ectx : ectx → ectx → ectx := flip (++).
|
|
|
|
|
|
Definition fill (K : ectx) (e : expr) : expr := foldl (flip fill_item) e K.
|
|
|
Lemma fill_app (K1 K2 : ectx) e : fill (K1 ++ K2) e = fill K2 (fill K1 e).
|
|
|
Proof. apply foldl_app. Qed.
|
|
|
Lemma fill_empty e : fill empty_ectx e = e.
|
|
|
Proof. done. Qed.
|
|
|
Lemma fill_comp K1 K2 e : fill K1 (fill K2 e) = fill (comp_ectx K1 K2) e.
|
|
|
Proof. unfold fill, comp_ectx; simpl. by rewrite foldl_app. Qed.
|
|
|
Global Instance fill_inj K : Inj (=) (=) (fill K).
|
|
|
Proof. induction K as [|Ki K IH]; unfold Inj; naive_solver. Qed.
|
|
|
|
|
|
Lemma fill_val K e : is_Some (to_val (fill K e)) → is_Some (to_val e).
|
|
|
Proof.
|
|
|
induction K as [|Ki K IH] in e |-*; [ done |]. by intros ?%IH%fill_item_val.
|
|
|
Qed.
|
|
|
Lemma fill_not_val K e : to_val e = None → to_val (fill K e) = None.
|
|
|
Proof. rewrite !eq_None_not_Some. eauto using fill_val. Qed.
|
|
|
|
|
|
End contexts.
|
|
|
|
|
|
(** Contextual steps *)
|
|
|
Inductive contextual_step : expr * heap → expr * heap → Prop :=
|
|
|
Ectx_step K e1 e2 σ1 σ2 e1' e2' :
|
|
|
e1 = fill K e1' → e2 = fill K e2' →
|
|
|
base_step (e1', σ1) (e2', σ2) → contextual_step (e1, σ1) (e2, σ2).
|
|
|
|
|
|
|
|
|
Lemma base_contextual_step e1 e2 σ1 σ2 :
|
|
|
base_step (e1, σ1) (e2, σ2) → contextual_step (e1, σ1) (e2, σ2).
|
|
|
Proof. apply Ectx_step with empty_ectx; by rewrite ?fill_empty. Qed.
|
|
|
|
|
|
Lemma fill_contextual_step K e1 e2 σ1 σ2 :
|
|
|
contextual_step (e1, σ1) (e2, σ2) → contextual_step (fill K e1, σ1) (fill K e2, σ2).
|
|
|
Proof.
|
|
|
inversion 1; subst.
|
|
|
rewrite !fill_comp. by econstructor.
|
|
|
Qed.
|
|
|
|
|
|
(** *** closedness *)
|
|
|
Fixpoint is_closed (X : list string) (e : expr) : bool :=
|
|
|
match e with
|
|
|
| Var x => bool_decide (x ∈ X)
|
|
|
| Lam x e => is_closed (x :b: X) e
|
|
|
| Unpack x e1 e2 => is_closed X e1 && is_closed (x :b: X) e2
|
|
|
| Lit _ => true
|
|
|
| UnOp _ e | Fst e | Snd e | InjL e | InjR e | TApp e | TLam e | Pack e | Roll e | Unroll e | Load e | New e=> is_closed X e
|
|
|
| App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 => is_closed X e1 && is_closed X e2
|
|
|
| If e0 e1 e2 | Case e0 e1 e2 =>
|
|
|
is_closed X e0 && is_closed X e1 && is_closed X e2
|
|
|
end.
|
|
|
|
|
|
(** [closed] states closedness as a Coq proposition, through the [Is_true] transformer. *)
|
|
|
Definition closed (X : list string) (e : expr) : Prop := Is_true (is_closed X e).
|
|
|
#[export] Instance closed_proof_irrel X e : ProofIrrel (closed X e).
|
|
|
Proof. unfold closed. apply _. Qed.
|
|
|
#[export] Instance closed_dec X e : Decision (closed X e).
|
|
|
Proof. unfold closed. apply _. Defined.
|
|
|
|
|
|
(** closed expressions *)
|
|
|
Lemma is_closed_weaken X Y e : is_closed X e → X ⊆ Y → is_closed Y e.
|
|
|
Proof. revert X Y; induction e; naive_solver (eauto; set_solver). Qed.
|
|
|
|
|
|
Lemma is_closed_weaken_nil X e : is_closed [] e → is_closed X e.
|
|
|
Proof. intros. by apply is_closed_weaken with [], list_subseteq_nil. Qed.
|
|
|
|
|
|
Lemma is_closed_subst X e x es :
|
|
|
is_closed [] es → is_closed (x :: X) e → is_closed X (subst x es e).
|
|
|
Proof.
|
|
|
intros ?.
|
|
|
induction e in X |-*; simpl; intros ?; destruct_and?; split_and?; simplify_option_eq;
|
|
|
try match goal with
|
|
|
| H : ¬(_ ∧ _) |- _ => apply not_and_l in H as [?%dec_stable|?%dec_stable]
|
|
|
end; eauto using is_closed_weaken with set_solver.
|
|
|
Qed.
|
|
|
Lemma is_closed_do_subst' X e x es :
|
|
|
is_closed [] es → is_closed (x :b: X) e → is_closed X (subst' x es e).
|
|
|
Proof. destruct x; eauto using is_closed_subst. Qed.
|
|
|
|
|
|
Lemma closed_is_closed X e :
|
|
|
is_closed X e = true ↔ closed X e.
|
|
|
Proof.
|
|
|
unfold closed. split.
|
|
|
- apply Is_true_eq_left.
|
|
|
- apply Is_true_eq_true.
|
|
|
Qed.
|
|
|
|
|
|
(** Substitution lemmas *)
|
|
|
Lemma subst_is_closed X e x es : is_closed X e → x ∉ X → subst x es e = e.
|
|
|
Proof.
|
|
|
induction e in X |-*; simpl; rewrite ?bool_decide_spec ?andb_True; intros ??;
|
|
|
repeat case_decide; simplify_eq; simpl; f_equal; intuition eauto with set_solver.
|
|
|
Qed.
|
|
|
|
|
|
Lemma subst_is_closed_nil e x es : is_closed [] e → subst x es e = e.
|
|
|
Proof. intros. apply subst_is_closed with []; set_solver. Qed.
|
|
|
Lemma subst'_is_closed_nil e x es : is_closed [] e → subst' x es e = e.
|
|
|
Proof. intros. destruct x as [ | x]. { done. } by apply subst_is_closed_nil. Qed.
|
|
|
|
|
|
(** ** More on the contextual semantics *)
|
|
|
|
|
|
Definition base_reducible (e : expr) σ :=
|
|
|
∃ e' σ', base_step (e, σ) (e', σ').
|
|
|
Definition base_irreducible (e : expr) σ :=
|
|
|
∀ e' σ', ¬base_step (e, σ) (e', σ').
|
|
|
Definition base_stuck (e : expr) σ :=
|
|
|
to_val e = None ∧ base_irreducible e σ.
|
|
|
|
|
|
(** Given a base redex [e1_redex] somewhere in a term, and another
|
|
|
decomposition of the same term into [fill K' e1'] such that [e1'] is not
|
|
|
a value, then the base redex context is [e1']'s context [K'] filled with
|
|
|
another context [K'']. In particular, this implies [e1 = fill K''
|
|
|
e1_redex] by [fill_inj], i.e., [e1]' contains the base redex.)
|
|
|
*)
|
|
|
Lemma step_by_val K' K_redex e1' e1_redex e2 σ1 σ2 :
|
|
|
fill K' e1' = fill K_redex e1_redex →
|
|
|
to_val e1' = None →
|
|
|
base_step (e1_redex, σ1) (e2, σ2) →
|
|
|
∃ K'', K_redex = comp_ectx K' K''.
|
|
|
Proof.
|
|
|
rename K' into K. rename K_redex into K'.
|
|
|
rename e1' into e1. rename e1_redex into e1'.
|
|
|
intros Hfill Hred Hstep; revert K' Hfill.
|
|
|
induction K as [|Ki K IH] using rev_ind; simpl; intros K' Hfill; eauto using app_nil_r.
|
|
|
destruct K' as [|Ki' K' _] using @rev_ind; simplify_eq/=.
|
|
|
{ rewrite fill_app in Hstep. apply base_ectxi_step_val in Hstep.
|
|
|
apply fill_val in Hstep. by apply not_eq_None_Some in Hstep. }
|
|
|
rewrite !fill_app in Hfill; simpl in Hfill.
|
|
|
assert (Ki = Ki') as ->.
|
|
|
{ eapply fill_item_no_val_inj, Hfill.
|
|
|
- by apply fill_not_val.
|
|
|
- apply fill_not_val. eauto using val_base_stuck.
|
|
|
}
|
|
|
simplify_eq. destruct (IH K') as [K'' ->]; auto.
|
|
|
exists K''. unfold comp_ectx; simpl. rewrite assoc; done.
|
|
|
Qed.
|
|
|
|
|
|
(** If [fill K e] takes a base step, then either [e] is a value or [K] is
|
|
|
the empty evaluation context. In other words, if [e] is not a value
|
|
|
wrapping it in a context does not add new base redex positions. *)
|
|
|
Lemma base_ectx_step_val K e e2 σ1 σ2 :
|
|
|
base_step (fill K e, σ1) (e2, σ2) → is_Some (to_val e) ∨ K = empty_ectx.
|
|
|
Proof.
|
|
|
destruct K as [|Ki K _] using rev_ind; simpl; [by auto|].
|
|
|
rewrite fill_app; simpl.
|
|
|
intros ?%base_ectxi_step_val; eauto using fill_val.
|
|
|
Qed.
|
|
|
|
|
|
(** If a [contextual_step] preserving a surrounding context [K] happens,
|
|
|
the reduction happens entirely below the context. *)
|
|
|
Lemma contextual_step_ectx_inv K e e' σ1 σ2 :
|
|
|
to_val e = None →
|
|
|
contextual_step (fill K e, σ1) (fill K e', σ2) →
|
|
|
contextual_step (e, σ1) (e', σ2).
|
|
|
Proof.
|
|
|
intros ? Hcontextual.
|
|
|
inversion Hcontextual as [??????? Heq1 Heq2 ?]; subst.
|
|
|
eapply step_by_val in H as (K'' & Heq); [ | done | done].
|
|
|
subst K0.
|
|
|
rewrite <-fill_comp in Heq1. rewrite <-fill_comp in Heq2.
|
|
|
apply fill_inj in Heq1. apply fill_inj in Heq2. subst.
|
|
|
econstructor; done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_ectx_step_case K e e' σ1 σ2 :
|
|
|
contextual_step (fill K e, σ1) (e', σ2) →
|
|
|
(∃ e'', e' = fill K e'' ∧ contextual_step (e, σ1) (e'', σ2)) ∨ is_val e.
|
|
|
Proof.
|
|
|
destruct (to_val e) as [ v | ] eqn:Hv.
|
|
|
{ intros _. right. apply is_val_spec. eauto. }
|
|
|
intros Hcontextual. left.
|
|
|
inversion Hcontextual as [K' ? ? ? ? e1' e2' Heq1 Heq2 Hstep]; subst.
|
|
|
eapply step_by_val in Heq1 as (K'' & ->); [ | done | done].
|
|
|
rewrite <-fill_comp.
|
|
|
eexists _. split; [done | ].
|
|
|
rewrite <-fill_comp in Hcontextual.
|
|
|
apply contextual_step_ectx_inv in Hcontextual; done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma base_reducible_contextual_step_ectx K e1 e2 σ1 σ2 :
|
|
|
base_reducible e1 σ1 →
|
|
|
contextual_step (fill K e1, σ1) (e2, σ2) →
|
|
|
∃ e2', e2 = fill K e2' ∧ base_step (e1, σ1) (e2', σ2).
|
|
|
Proof.
|
|
|
intros (e2''&σ2'' & HhstepK) Hctx.
|
|
|
inversion Hctx as [K' ???? e1' e2' HKe1 -> Hstep].
|
|
|
edestruct (step_by_val K) as [K'' ?];
|
|
|
eauto using val_base_stuck; simplify_eq/=.
|
|
|
rewrite <-fill_comp in HKe1; simplify_eq.
|
|
|
exists (fill K'' e2'). rewrite fill_comp; split; [done | ].
|
|
|
apply base_ectx_step_val in HhstepK as [[v ?]|?]; simplify_eq.
|
|
|
{ apply val_base_stuck in Hstep; simplify_eq. }
|
|
|
by rewrite !fill_empty.
|
|
|
Qed.
|
|
|
|
|
|
Lemma base_reducible_contextual_step e1 e2 σ1 σ2 :
|
|
|
base_reducible e1 σ1 →
|
|
|
contextual_step (e1, σ1) (e2, σ2) →
|
|
|
base_step (e1, σ1) (e2, σ2).
|
|
|
Proof.
|
|
|
intros.
|
|
|
edestruct (base_reducible_contextual_step_ectx empty_ectx) as (?&?&?);
|
|
|
rewrite ?fill_empty; eauto.
|
|
|
by simplify_eq; rewrite fill_empty.
|
|
|
Qed.
|
|
|
|
|
|
(** *** Reducibility *)
|
|
|
Definition reducible (e : expr) σ :=
|
|
|
∃ e' σ', contextual_step (e, σ) (e', σ').
|
|
|
Definition irreducible (e : expr) σ :=
|
|
|
∀ e' σ', ¬contextual_step (e, σ) (e', σ').
|
|
|
Definition stuck (e : expr) σ :=
|
|
|
to_val e = None ∧ irreducible e σ.
|
|
|
Definition not_stuck (e : expr) σ :=
|
|
|
is_Some (to_val e) ∨ reducible e σ.
|
|
|
|
|
|
Lemma base_step_not_stuck e e' σ σ' : base_step (e, σ) (e', σ') → not_stuck e σ.
|
|
|
Proof. unfold not_stuck, reducible; simpl. eauto 10 using base_contextual_step. Qed.
|
|
|
|
|
|
Lemma val_stuck e e' σ σ' : contextual_step (e, σ) (e', σ') → to_val e = None.
|
|
|
Proof.
|
|
|
inversion 1 as [??????? -> -> ?%val_base_stuck].
|
|
|
apply eq_None_not_Some. by intros ?%fill_val%eq_None_not_Some.
|
|
|
Qed.
|
|
|
Lemma not_reducible e σ : ¬reducible e σ ↔ irreducible e σ.
|
|
|
Proof. unfold reducible, irreducible. naive_solver. Qed.
|
|
|
Lemma reducible_not_val e σ : reducible e σ → to_val e = None.
|
|
|
Proof. intros (?&?&?). eauto using val_stuck. Qed.
|
|
|
Lemma val_irreducible e σ : is_Some (to_val e) → irreducible e σ.
|
|
|
Proof. intros [??] ?? ?%val_stuck. by destruct (to_val e). Qed.
|
|
|
|
|
|
Lemma irreducible_fill K e σ :
|
|
|
irreducible (fill K e) σ → irreducible e σ.
|
|
|
Proof.
|
|
|
intros Hirred e' σ' Hstep.
|
|
|
eapply Hirred. by apply fill_contextual_step.
|
|
|
Qed.
|
|
|
|
|
|
Lemma base_reducible_reducible e σ :
|
|
|
base_reducible e σ → reducible e σ.
|
|
|
Proof. intros (e' & σ' & Hhead). exists e', σ'. by apply base_contextual_step. Qed.
|
|
|
|
|
|
|
|
|
(* we derive a few lemmas about contextual steps *)
|
|
|
Lemma contextual_step_app_l e1 e1' e2 σ1 σ2 :
|
|
|
is_val e2 →
|
|
|
contextual_step (e1, σ1) (e1', σ2) →
|
|
|
contextual_step (App e1 e2, σ1) (App e1' e2, σ2).
|
|
|
Proof.
|
|
|
intros [v <-%of_to_val]%is_val_spec Hcontextual.
|
|
|
by eapply (fill_contextual_step [AppLCtx _]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_app_r e1 e2 e2' σ1 σ2 :
|
|
|
contextual_step (e2, σ1) (e2', σ2) →
|
|
|
contextual_step (App e1 e2, σ1) (App e1 e2', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [AppRCtx e1]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_tapp e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (TApp e, σ1) (TApp e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [TAppCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_pack e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Pack e, σ1) (Pack e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [PackCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_unpack x e e' e2 σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Unpack x e e2, σ1) (Unpack x e' e2, σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [UnpackCtx x e2]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_unop op e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (UnOp op e, σ1) (UnOp op e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [UnOpCtx op]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_binop_l op e1 e1' e2 σ1 σ2 :
|
|
|
is_val e2 →
|
|
|
contextual_step (e1, σ1) (e1', σ2) →
|
|
|
contextual_step (BinOp op e1 e2, σ1) (BinOp op e1' e2, σ2).
|
|
|
Proof.
|
|
|
intros [v <-%of_to_val]%is_val_spec Hcontextual.
|
|
|
by eapply (fill_contextual_step [BinOpLCtx op v]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_binop_r op e1 e2 e2' σ1 σ2 :
|
|
|
contextual_step (e2, σ1) (e2', σ2) →
|
|
|
contextual_step (BinOp op e1 e2, σ1) (BinOp op e1 e2', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [BinOpRCtx op e1]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_if e e' e1 e2 σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (If e e1 e2, σ1) (If e' e1 e2, σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [IfCtx e1 e2]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_pair_l e1 e1' e2 σ1 σ2 :
|
|
|
is_val e2 →
|
|
|
contextual_step (e1, σ1) (e1', σ2) →
|
|
|
contextual_step (Pair e1 e2, σ1) (Pair e1' e2, σ2).
|
|
|
Proof.
|
|
|
intros [v <-%of_to_val]%is_val_spec Hcontextual.
|
|
|
by eapply (fill_contextual_step [PairLCtx v]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_pair_r e1 e2 e2' σ1 σ2 :
|
|
|
contextual_step (e2, σ1) (e2', σ2) →
|
|
|
contextual_step (Pair e1 e2, σ1) (Pair e1 e2', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [PairRCtx e1]).
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
Lemma contextual_step_fst e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Fst e, σ1) (Fst e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [FstCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_snd e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Snd e, σ1) (Snd e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [SndCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_injl e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (InjL e, σ1) (InjL e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [InjLCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_injr e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (InjR e, σ1) (InjR e', σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [InjRCtx]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_case e e' e1 e2 σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Case e e1 e2, σ1) (Case e' e1 e2, σ2).
|
|
|
Proof.
|
|
|
intros Hcontextual.
|
|
|
by eapply (fill_contextual_step [CaseCtx e1 e2]).
|
|
|
Qed.
|
|
|
|
|
|
Lemma contextual_step_roll e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Roll e, σ1) (Roll e', σ2).
|
|
|
Proof. by apply (fill_contextual_step [RollCtx]). Qed.
|
|
|
|
|
|
Lemma contextual_step_unroll e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Unroll e, σ1) (Unroll e', σ2).
|
|
|
Proof. by apply (fill_contextual_step [UnrollCtx]). Qed.
|
|
|
|
|
|
Lemma contextual_step_new e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (New e, σ1) (New e', σ2).
|
|
|
Proof. by apply (fill_contextual_step [NewCtx]). Qed.
|
|
|
|
|
|
Lemma contextual_step_load e e' σ1 σ2 :
|
|
|
contextual_step (e, σ1) (e', σ2) →
|
|
|
contextual_step (Load e, σ1) (Load e', σ2).
|
|
|
Proof. by apply (fill_contextual_step [LoadCtx]). Qed.
|
|
|
|
|
|
Lemma contextual_step_store_r e1 e2 e2' σ1 σ2 :
|
|
|
contextual_step (e2, σ1) (e2', σ2) →
|
|
|
contextual_step (Store e1 e2, σ1) (Store e1 e2', σ2).
|
|
|
Proof. by apply (fill_contextual_step [StoreRCtx _]). Qed.
|
|
|
|
|
|
Lemma contextual_step_store_l e1 e1' e2 σ1 σ2 :
|
|
|
is_val e2 →
|
|
|
contextual_step (e1, σ1) (e1', σ2) →
|
|
|
contextual_step (Store e1 e2, σ1) (Store e1' e2, σ2).
|
|
|
Proof.
|
|
|
intros [v <-%of_to_val]%is_val_spec Hcontextual.
|
|
|
by eapply (fill_contextual_step [StoreLCtx _]).
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
#[export]
|
|
|
Hint Resolve
|
|
|
contextual_step_app_l contextual_step_app_r contextual_step_binop_l contextual_step_binop_r
|
|
|
contextual_step_case contextual_step_fst contextual_step_if contextual_step_injl contextual_step_injr
|
|
|
contextual_step_pack contextual_step_pair_l contextual_step_pair_r contextual_step_snd contextual_step_tapp
|
|
|
contextual_step_tapp contextual_step_unop contextual_step_unpack contextual_step_roll contextual_step_unroll
|
|
|
contextual_step_new contextual_step_load contextual_step_store_r contextual_step_store_l : core.
|