RunST.reduction

From iris.program_logic Require Import language.

Notation pstep' l :=
  (λ x1 x2, @prim_step l (fst x1) (snd x1) (fst x2) (snd x2) []).
Notation pstep := (λ x1 x2, prim_step (fst x1) (snd x1) (fst x2) (snd x2) []).

Lemma nsteps_val l k v σ e' σ':
  nsteps pstep k (of_val v, σ) (e', σ') k = 0 e' = (@of_val l v) σ = σ'.
Proof.
  inversion 1 as [|Hs1 Hs2 Hs3 Hs4 Hs5 Hs6]; simpl in *; subst; first done.
  by apply val_stuck in Hs5; rewrite to_of_val in Hs5.
Qed.

Lemma nsteps_bind {Λ} K `{!LanguageCtx Λ K} {n e σ v σ'} :
  nsteps pstep n (K e, σ) (of_val v, σ')
   k σ'' w, k n nsteps pstep k (e, σ) (of_val w, σ'')
             nsteps pstep (n - k) (K (of_val w), σ'') (of_val v, σ').
Proof.
  destruct (to_val e) as [w|] eqn:?;
    first (subst; apply of_to_val in Heqo as <-).
  { exists 0, σ, w; replace (n-0) with n by omega;
      repeat split; [|constructor|]; auto with omega. }
  revert e σ Heqo; induction n => e σ Heqo Hr.
  - inversion Hr as [Hs1 Hs2 Hs3 Hs4|]; subst.
    assert (Hkv : to_val (K e) = None) by by rewrite fill_not_val.
    by rewrite Hs4 to_of_val in Hkv.
  - inversion Hr as [|Hs1 Hs2 [e2 σ2] Hs4 Hs5 Hs6]; subst.
    simpl in *.
    apply fill_step_inv in Hs5; trivial.
    destruct Hs5 as [e2' [Hs51 Hs5]]; subst.
    destruct (to_val e2') as [w'|] eqn:Heqo';
      first (subst; apply of_to_val in Heqo' as <-).
    { exists 1, σ2, w'.
      simpl; replace (n-0) with n by omega.
      repeat split; auto with omega.
      eapply (nsteps_l _ _ _ (_, _) (_, _)); simpl; eauto.
      constructor. }
    destruct (IHn e2' σ2 Heqo' Hs6) as (k & σ'' & z & Hle & Hstp1 & Hstp2).
    exists (S k), σ'', z; repeat split; auto with omega.
    eapply (nsteps_l _ _ _ (_, _) (_, _)); simpl; eauto.
Qed.

Lemma nsteps_bind' {Λ} K `{!LanguageCtx Λ K} {n n' e σ v σ' e'' σ''} :
  nsteps pstep n (e, σ) (of_val v, σ')
  nsteps pstep n' (K (of_val v), σ') (e'', σ'')
  nsteps pstep (n + n') (K e, σ) (e'', σ'').
Proof.
  revert n' e σ v σ' e'' σ''.
  induction n => n' e σ v σ' e'' σ''.
  { by intros H1; inversion H1; subst; simpl in *. }
  intros H1 H2; inversion H1 as [|Hs1 Hs2 [e2 σ2] Hs4 Hs5 Hs6];
    subst; simpl in *.
  eapply (nsteps_l _ _ _ (_, _) (_, _)); simpl; eauto.
  by apply fill_step.
Qed.

Lemma nsteps_ctx {Λ} K `{!LanguageCtx Λ K} {n e σ e' σ'} :
  nsteps pstep n (e, σ) (e', σ')
  nsteps pstep n (K e, σ) (K e', σ').
Proof.
  revert e σ e' σ'; induction n => e σ e' σ'; inversion 1 as [[? ?]|? ? [? ?]]; subst.
  - econstructor.
  - eapply (nsteps_l _ _ _ (_, _) (_, _)); simpl in *; eauto.
    eapply fill_step; eauto.
Qed.

Lemma rtc_ctx {Λ} K `{!LanguageCtx Λ K} {e σ e' σ'} :
  rtc pstep (e, σ) (e', σ')
  rtc pstep (K e, σ) (K e', σ').
Proof.
  move=> H. apply rtc_nsteps in H as [n H]. apply (nsteps_rtc n).
  by apply nsteps_ctx.
Qed.

Definition nf_reducible {l : language} e σ := e' σ', @prim_step l e σ e' σ' [].
Lemma nf_red_red {l} e σ : nf_reducible e σ @reducible l e σ.
Proof. destruct 1 as [? [? ?]]; eexists; eauto. Qed.

From iris.program_logic Require ectx_language.

Section nf_head_reducible.
  Context {expr val ectx state}
          {Λ : ectx_language.EctxLanguage expr val ectx state}.

  Definition nf_head_reducible e σ :=
     e' σ', @ectx_language.head_step _ _ _ _ Λ e σ e' σ' [].
  Lemma nf_head_red_head_red e σ :
    nf_head_reducible e σ ectx_language.head_reducible e σ.
  Proof. destruct 1 as [? [? ?]]; eexists; eauto. Qed.

  Lemma nf_head_reducible_nf_reducible e σ :
    nf_head_reducible e σ @nf_reducible (ectx_language.ectx_lang _) e σ.
  Proof.
    destruct 1 as [? [? ?]]; do 2 eexists.
    eapply ectx_language.head_prim_step; eauto.
  Qed.

End nf_head_reducible.

From iris.program_logic Require ectxi_language.

Section step_by_val_strong.
  Context {expr val ectx_item state}
          {Λ : ectxi_language.EctxiLanguage expr val ectx_item state}.

  Lemma step_by_val_strong K K' e1 e1' σ1 e2 σ2 efs σ1' e2' σ2' efs' :
    ectxi_language.fill K e1 = ectxi_language.fill K' e1'
    ectx_language.head_step e1 σ1 e2 σ2 efs
    ectx_language.head_step e1' σ1' e2' σ2' efs' K = K'.
  Proof.
  intros HK Hh1 Hh2.
  edestruct ectxi_language.step_by_val as [K3 HK3]; eauto.
  eapply ectxi_language.val_stuck; eauto.
  symmetry in HK.
  edestruct ectxi_language.step_by_val as [K4 HK4]; eauto.
  eapply ectxi_language.val_stuck; eauto.
  rewrite HK3 in HK4.
  assert (K3 = []) as HK3eq.
  { destruct K3; auto. clear -HK4. induction K; inversion HK4; auto. }
  rewrite HK3eq in HK3.
  by rewrite app_nil_r in HK3.
  Qed.

End step_by_val_strong.