mpri-funcprog-project/coq/CPSSubstitution.v

Require Import MyTactics.
Require Import LambdaCalculusSyntax.
Require Import LambdaCalculusValues.
Require Import CPSDefinition.
Require Import CPSContextSubstitution.
Require Import CPSRenaming.

(* The CPS transformation commutes with certain substitutions. More precisely,
   it commutes with a substitution [sigma] of values for variables, up to a
   transformation of the values in the codomain of [sigma].

   In the case of [cpsv], we have the following diagram: applying [sigma]
   first, followed with [cpsv], is the same as applying [cpsv] first, followed
   with [sigma >>> cpsv].

    cpsv v.[sigma] = (cpsv v).[sigma >>> cpsv]

  This can also be written in point-free style, that is, without mentioning
  the value [v]:

    subst sigma >>> cpsv = cpsv >>> subst (sigma >>> cpsv)

  As in the case of the renaming lemma (see CPSRenaming.v), this statement is
  proved by induction on the size of terms, together with an analogous
  statement about the function [cps]. *)

(* The proof depends on [CPSRenaming] via the lemmas [up_sigma_cpsv] and
   [upn_sigma_cpsv], which are declared as hints for [obvious]. *)

Lemma substitution:
  (
    forall v sigma sigma',
    sigma' = sigma >>> cpsv ->
    is_value_subst sigma ->
    (cpsv v).[sigma'] = cpsv v.[sigma]
  ) /\ (
    forall t c sigma c' sigma',
    sigma' = sigma >>> cpsv ->
    is_value_subst sigma ->
    substc sigma' c = c' ->
    (cps t c).[sigma'] = cps t.[sigma] c'
  ).
Proof.
  eapply mutual_induction.
  (* [cpsv] *)
  { intros n IHcps v Hvn sigma sigma' Heq Hsigma. subst.
    destruct v; asimpl; cpsv; asimpl; try reflexivity.
    (* Lam *)
    { erewrite IHcps by obvious. asimpl. reflexivity. }
  }
  (* [cps] *)
  { intros n IHcpsv IHcps t c Htn sigma c' sigma' Heq Hsigma Hsubstc. subst.
    value_or_app_or_let t; asimpl; cps.
    (* Case: [t] is a value. *)
    { erewrite apply_substitution by eauto.
      erewrite IHcpsv by obvious.
      reflexivity. }
    (* Case: [t] is an application. *)
    { eapply IHcps; obvious.
      simpl. f_equal.
      erewrite <- lift_up by tc.
      eapply IHcps; obvious.
      asimpl. do 2 f_equal.
      rewrite lift_reify.
      eapply reify_substitution.
      rewrite substc_substc.
      reflexivity. }
    (* Case: [t] is a [let] construct. *)
    { eapply IHcps; obvious.
      simpl.
      rewrite fold_up_up.
      do 2 f_equal.
      erewrite IHcps by first [ eapply substc_liftc_liftc; eauto | obvious ].
      autosubst. }
  }
Qed.

(* The projections of the above result. *)

Definition cpsv_substitution := proj1 substitution.
Definition cps_substitution  := proj2 substitution.

(* A point-free reformulation of the above result: [cpsv] commutes with an
   arbitrary substitution [sigma], up to a transformation of the values in the
   codomain of [sigma]. *)

Goal
  forall sigma,
  is_value_subst sigma ->
  cpsv >>> subst (sigma >>> cpsv) =
  subst sigma >>> cpsv.
Proof.
  intros. f_ext; intros v. asimpl. eauto using cpsv_substitution.
Qed.

(* This technical lemma is used below. *)

Lemma cpsv_cons:
  forall v,
  cpsv v .: ids = (v .: ids) >>> cpsv.
Proof.
  intros. f_ext; intros [|x]; autosubst.
Qed.

(* A corollary where the substitution [sigma] is [v .: ids], that is, a
   substitution of the value [v] for the variable 0. This one is about
   [cpsv]. *)

Lemma cpsv_substitution_0:
  forall v w,
  is_value v ->
  (cpsv w).[cpsv v/] =
  cpsv w.[v/].
Proof.
  intros. rewrite cpsv_cons. erewrite cpsv_substitution by obvious. reflexivity.
Qed.

(* Another corollary where the substitution [sigma] is [v .: ids], that is, a
   substitution of the value [v] for the variable 0. This one is about [cps]
   and concerns the case where the continuation is of the form [liftc 1 c], so
   it is unaffected. *)

Lemma cps_substitution_0:
  forall t c v,
  is_value v ->
  (cps t (liftc 1 c)).[cpsv v/] =
  cps t.[v/] c.
Proof.
  intros. eapply cps_substitution.
  { autosubst. }
  { obvious. }
  { eauto using substc_liftc_single. }
Qed.

(* A corollary where the substitution [sigma] is [up (v .: ids)], that is, a
   substitution of the value [v] for the variable 1, and the continuation is
   the variable 0, so it is unaffected. *)

Lemma cps_substitution_1_O_Var_0:
  forall t v,
  is_value v ->
  (cps t (O (Var 0))).[up (cpsv v .: ids)] =
  cps t.[up (v .: ids)] (O (Var 0)).
Proof.
  intros. eapply cps_substitution.
  { rewrite cpsv_cons. obvious. }
  { obvious. }
  { reflexivity. }
Qed.