 ### Add the Coq formalization of the CPS transformation.

parent 79af3f8d
 Require Import MyTactics. Require Import LambdaCalculusSyntax. Require Import LambdaCalculusValues. Require Import CPSDefinition. (* This file contains a few lemmas about [substc]. *) (* Two successive applications of [substc] can be fused. *) Lemma substc_substc: forall sigma1 sigma2 c, substc sigma2 (substc sigma1 c) = substc (sigma1 >> sigma2) c. Proof. intros. destruct c; autosubst. Qed. (* Two successive applications of [liftc] can be fused. *) Lemma liftc_liftc: forall i j c, liftc i (liftc j c) = liftc (i + j) c. Proof. intros i j c. destruct c; autosubst. Qed. (* [apply] commutes with substitutions. *) Lemma apply_substitution: forall c sigma c' v, substc sigma c = c' -> (apply c v).[sigma] = apply c' v.[sigma]. Proof. intros. subst. destruct c; autosubst. Qed. (* [reify] commutes with substitutions. *) Lemma reify_substitution: forall c sigma c', substc sigma c = c' -> (reify c).[sigma] = reify c'. Proof. intros. subst. destruct c; reflexivity. Qed. (* As a special case, [reify] commutes with lifting. *) Lemma lift_reify: forall i c, lift i (reify c) = reify (liftc i c). Proof. intros. destruct c; reflexivity. Qed. (* [substc] is preserved by [liftc]. *) Lemma substc_liftc_liftc: forall i c sigma c', substc sigma c = c' -> substc (upn i sigma) (liftc i c) = liftc i c'. Proof. intros. subst. destruct c; simpl. { rewrite lift_upn by tc. reflexivity. } { asimpl. erewrite plus_upn by tc. autosubst. } Qed. Hint Resolve substc_liftc_liftc : obvious. (* As is the case for terms, lifting [c] by 1, then applying a substitution of the form [v .: ids], yields [c] again. *) Lemma substc_liftc_single: forall c v, substc (v .: ids) (liftc 1 c) = c. Proof. intros. destruct c; autosubst. Qed.
 Require Import MyTactics. Require Import Sequences. Require Import Relations. Require Import LambdaCalculusSyntax. Require Import LambdaCalculusValues. Require Import LambdaCalculusReduction. Require Import LambdaCalculusStandardization. Require Import CPSDefinition. Require Import CPSSpecialCases. Require Import CPSSimulation. (* [cbv+ . pcbv] implies [pcbv*]. *) Lemma technical_inclusion_0: inclusion plus_cbv_pcbv (star pcbv). Proof. intros t1 t2. unfold composition. intros. unpack. eauto 6 using cbv_subset_pcbv, plus_covariant with sequences. Qed. (* [(cbv+ . pcbv)*] implies [pcbv*]. *) Lemma technical_inclusion_1: inclusion (star plus_cbv_pcbv) (star pcbv). Proof. eapply inclusion_transitive; [| eapply inclusion_star_star ]. eapply star_covariant_inclusion. eapply technical_inclusion_0. Qed. (* A simplified simulation diagram. *) Lemma simulation_cbv_pcbv: forall t t', star cbv t t' -> star pcbv (cps t init) (cps t' init). Proof. intros t t' Hred. (* According to the simulation diagram (iterated), [cps t c] reduces to [cps v c] via a series of [cbv] and [pcbv] steps. *) destruct (star_diamond_left _ _ _ cps_init_simulation _ _ Hred _ eq_refl) as (?&?&?). subst. (* Thus, [cps t c] reduces to [cps t' c] via [pcbv*]. *) eapply technical_inclusion_1. eauto. Qed. (* If [t] diverges, then [cps t init] diverges, too. *) Lemma cps_preserves_divergence: forall t, infseq cbv t -> infseq cbv (cps t init). Proof. intros. eapply pcbv_preserves_divergence. eapply infseq_simulation. { eapply cps_init_simulation. } { eauto. } { tauto. } Qed. (* If [t] converges to a value [v], then [cps t init] converges to a value [w]. Furthermore, [w] reduces to [cpsv v] via a number of parallel reduction steps. *) Lemma cps_preserves_convergence: forall t v, star cbv t v -> is_value v -> exists w, star cbv (cps t init) w /\ is_value w /\ star pcbv w (cpsv v). Proof. intros ? ? Htv Hv. (* [cps t init] reduces to [cps v init] via [pcbv*]. *) generalize (simulation_cbv_pcbv _ _ Htv); intro Hred. (* [cps v init] is [cpsv v]. *) assert (Heq: cps v init = cpsv v). { cps. reflexivity. } (* Thus, [cps t init] reduces to [cpsv v] via [pcbv*]. *) rewrite Heq in Hred. (* Bifurcate this reduction sequence. *) forward1 crarys_lemma9. clear Hred. (* This gives us the value [w] that we are looking for. *) eexists. split. eauto. split. { eauto using (star_implication_reversed _ ipcbv_preserves_values_reversed) with obvious. } { eauto using star_covariant, ipcbv_subset_pcbv. } Qed. (* If [t] is stuck, then [cps t c] is stuck. Not a really interesting property, but we prove it, just so that no stone is left unturned. *) Lemma cps_preserves_stuck: forall t, stuck t -> forall c, stuck (cps t c). Proof. induction 1; intros. (* StuckApp *) { rewrite cps_app_value_value by eauto. eapply StuckAppL. eapply StuckApp; [ obvious | obvious |]. (* Only [Lam] is translated to [Lam]. *) intros. destruct v1. { cpsv. congruence. } { cpsv. false. congruence. } { obvious. } { obvious. } } (* StuckAppL *) { cps. eauto. } (* StuckAppR *) { rewrite cps_app_value by eauto. eauto. } (* StuckLetL *) { cps. eauto. } Qed. (* As a corollary, the property of going wrong is preserved by the CPS transformation. *) Lemma cps_preserves_going_wrong: forall t, goes_wrong t -> goes_wrong (cps t init). Proof. intros ? [ t' [ Htt' ? ]]. (* [cps t init] reduces to [cps t' init] via [pcbv*]. *) generalize (simulation_cbv_pcbv _ _ Htt'); intro Hred. (* Bifurcate this reduction sequence. *) forward1 crarys_lemma9. clear Hred. (* This gives us the stuck term we are looking for. *) eexists. split. eauto. eauto using cps_preserves_stuck, reverse_star_ipcbv_preserves_stuck. Qed.
 Require Import MyTactics. Require Import Sequences. Require Import LambdaCalculusSyntax. Require Import LambdaCalculusValues. Require Import LambdaCalculusReduction. Require Import CPSDefinition. (* The single-step simulation lemma in Danvy and Filinski's paper states that if [t1] reduces to [t2], then [cps t1 c] reduces (in one or more steps) to [cps t2 c]. Although this lemma is true in the pure lambda calculus, it fails when the calculus is extended with [Let]. This file provides two counter-examples. *) (* Although Danvy and Filinski's paper does not claim that this lemma holds when the calculus is extended with [Let], it does not indicate that the lemma fails, either. *) (* -------------------------------------------------------------------------- *) (* The tactic [analyze] assumes that there is a hypothesis [star cbv t1 t2]. It checks that [t1] and [t2] are distinct and, if [t1] reduces to [t'1], updates this hypothesis to [star cbv t'1 t2]. Repeating this tactic allows proving that [t1] does *not* reduce to [t2]. *) Ltac analyze := invert_star_cbv; repeat invert_cbv; compute in *; fold cbv_mask in *; repeat match goal with h: True |- _ => clear h end. Transparent cps cpsv. (* required by [compute] *) (* -------------------------------------------------------------------------- *) (* Consider the term [t1], defined as follows. In informal syntax, [t1] is written (\z.let w = z in w) (\x.x). *) Definition t1 := App (Lam (Let (Var 0) (Var 0))) (Lam (Var 0)). (* The term [t1] reduces to [t2], which in informal syntax is written let w = \x.x in w. *) Definition t2 := Let (Lam (Var 0)) (Var 0). Goal cbv t1 t2. Proof. unfold t1, t2. obvious. Qed. (* The single-step simulation diagram is violated: [cps t1 init] does *not* reduce (in any number of steps) to [cps t2 init]. *) Goal ~ (star cbv (cps t1 init) (cps t2 init)). Proof. compute; fold cbv_mask. intro. analyze. analyze. (* This point is the near miss: [cps t1 init] has now reduced to a [Let] construct, whereas [cps t2 init] is a similar-looking [Let] construct. Both have the same value on the left-hand side of the [Let]. But the right-hand sides of the [Let] construct differ. *) analyze. analyze. analyze. Qed. (* Let us summarize. The term [t1] reduces in one step to [t2] as follows: (\z.let w = z in w) (\x.x) -> let w = \x.x in w The term [cps t1 init], in informal notation, is as follows: (\z.\k.let w = z in k w) (\x.\k. k x) (\w.w) This term reduces in two steps to: let w = \x.\k. k x in (\w.w) w But the term [cps t2 init], in informal notation, is: let w = \x.\k. k x in w This is our near miss. Both terms are [let] constructs and both have the same left-hand side, but the right-hand sides differ by a beta-v reduction. Thus, [cps t1 init] does not reduce *in call-by-value* to [cps t2 init]. In order to allow [cps u1 init] to join [cps u2 init], we must allow beta-v reductions in the right-hand side of [let] constructs (and, it turns out, under lambda-abstractions, too.) This is visible in the proof of the [simulation] lemma in the file CPSSimulation: there, we use the reduction strategy [pcbv], which allows (parallel) beta-v reductions under arbitrary contexts. *) (* This counter-example is one of two closed counter-examples of minimal size. It has size 4 (counting [Lam], [App], and [Let] nodes) and involves only one [Let] construct. There are no smaller counter-examples. An exhaustive search procedure, coded in OCaml, was used to find it. *)