Commit 68553641 authored by Paul Wild's avatar Paul Wild

move definition of contexts to Language.v/Lib.v,

move soundness proofs to Binary{Typed}/Compatibility.v
parent 88618d6c
......@@ -2,3 +2,6 @@
*.v.d
*.vo
*.swp
project/coqdoc.css
project/Makefile.bak
project/html
......@@ -531,3 +531,63 @@ Proof.
induction 1; subst; eauto using types_closed_t with compat.
Qed.
(** ** Soundness
TODO
Now the proof of the compatibility lemma becomes a simple matter of combining
the previous compatibility lemmas and the Fundamental property together,
using the closedness lemmas to deal with any closedness conditions that arise.
*)
Lemma compat_cont : forall C k k' Γ Γ' t t' e1 e2
(HCT: ctypes C (k, Γ, t) (k', Γ', t'))
(HL: logrel k Γ e1 e2 t),
logrel k' Γ' (csubst C e1) (csubst C e2) t'.
Proof.
induction C; intros; simpl; inversion HCT; subst;
eauto 6 using Fundamental, ctypes_closed_t, types_closed_t with compat.
Qed.
(** Definition of contextual approximation: *)
Definition terminates e := exists (v : val), e * v.
Definition contapprox k Γ e1 e2 t :=
forall C t'
(HCT : ctypes C (k, Γ, t) (0, , t'))
(Hterm : terminates (csubst C e1)),
terminates (csubst C e2).
(**
Finally, here is the proof of the Soundness property. The proof works by
induction on the number of steps taken by [csubst C e1] to terminate at a value.
*)
Theorem Soundness : forall k Γ e1 e2 t
(HT1: [ k | Γ e1 ::: t ])
(HT2: [ k | Γ e2 ::: t ])
(HL: logrel k Γ e1 e2 t),
contapprox k Γ e1 e2 t.
Proof.
unfold contapprox; intros.
(* Use the compatibility lemma. *)
apply (compat_cont _ _ _ _ _ _ _ _ _ HCT) in HL.
assert (HC := ctypes_closed_t HCT).
(* Use mstep_stepn to obtain the number of steps, and use that number to
instantiate the logical relation. *)
destruct Hterm as [v HS']; destruct (mstep_stepn _ _ HS') as [n HS]; clear HS'.
assert (HL': E[[t']] empFinI n (csubst C e1, csubst C e2)).
apply (csubst_type HCT), types_closed_e in HT1.
apply (csubst_type HCT), types_closed_e in HT2.
eapply HL; eauto; [apply rel_nil | reflexivity | reflexivity].
revert HS HL'; generalize (csubst C e1) (csubst C e2); clear - HC.
induction n using wf_ind_lt; rename H into HInd; intros e1 e2 HS1 HL.
destruct n as [| n]; inversion HS1; subst.
- rewrite eval_simpl in HL; apply proj1 in HL; specialize (HL (val_irred v)).
destruct HL as [ e2' [ HS2 HL ] ]; apply interp_values, proj2 in HL.
inversion HL as [v' EQ]; subst; eexists; eauto.
- rewrite eval_simpl in HL; apply proj2 in HL.
eapply HInd, HL; eauto with arith.
Qed.
This diff is collapsed.
......@@ -683,3 +683,62 @@ Proof.
induction 1; subst; eauto using types_closed_t with compat.
Qed.
(** ** Soundness
TODO
Now the proof of the compatibility lemma becomes a simple matter of combining
the previous compatibility lemmas and the Fundamental property together,
using the closedness lemmas to deal with any closedness conditions that arise.
*)
Lemma compat_cont : forall C k k' Γ Γ' t t' e1 e2
(HCT: ctypes C (k, Γ, t) (k', Γ', t'))
(HL: logrel k Γ e1 e2 t),
logrel k' Γ' (csubst C e1) (csubst C e2) t'.
Proof.
induction C; intros; simpl; inversion HCT; subst;
eauto 6 using Fundamental, ctypes_closed_t, types_closed_t with compat.
Qed.
(** Definition of contextual approximation: *)
Definition terminates e := exists (v : val), e * v.
Definition contapprox k Γ e1 e2 t :=
forall C t'
(HCT : ctypes C (k, Γ, t) (0, , t'))
(Hterm : terminates (csubst C e1)),
terminates (csubst C e2).
(**
Finally, here is the proof of the Soundness property. The proof works by
induction on the number of steps taken by [csubst C e1] to terminate at a value.
*)
Theorem Soundness : forall k Γ e1 e2 t
(HT1: [ k | Γ e1 ::: t ])
(HT2: [ k | Γ e2 ::: t ])
(HL: logrel k Γ e1 e2 t),
contapprox k Γ e1 e2 t.
Proof.
unfold contapprox; intros.
(* Use the compatibility lemma. *)
apply (compat_cont _ _ _ _ _ _ _ _ _ HCT) in HL.
assert (HC := ctypes_closed_t HCT).
(* Use mstep_stepn to obtain the number of steps, and use that number to
instantiate the logical relation. *)
destruct Hterm as [v HS']; destruct (mstep_stepn _ _ HS') as [n HS]; clear HS'.
assert (HL': E[[t']] empFinI n (csubst C e1, csubst C e2)).
apply (csubst_type HCT), types_closed_e in HT1.
apply (csubst_type HCT), types_closed_e in HT2.
eapply HL; eauto; [apply rel_nil | reflexivity | reflexivity].
revert HS HL'; generalize (csubst C e1) (csubst C e2); clear - HC.
induction n using wf_ind_lt; rename H into HInd; intros e1 e2 HS1 HL.
destruct n as [| n]; inversion HS1; subst.
- rewrite eval_simpl in HL; apply proj1 in HL; specialize (HL (val_irred v)).
destruct HL as [ e2' [ HS2 HL ] ]; apply interp_values, proj2 in HL.
inversion HL as [v' EQ]; subst; eexists; eauto.
- rewrite eval_simpl in HL; apply proj2 in HL.
eapply HInd, HL; eauto with arith.
Qed.
This diff is collapsed.
......@@ -3,7 +3,7 @@ Require Import ModuRes.Constr ModuRes.UPred ModuRes.COFE.
Require Import Omega List.
Require Import Language Lib Tactics.
Require Import BinaryTyped.WeakSubSyntactic BinaryTyped.LogRel BinaryTyped.WeakSub
BinaryTyped.Compatibility BinaryTyped.Soundness.
BinaryTyped.Compatibility.
Open Scope lang_scope.
......
......@@ -241,7 +241,6 @@ Notation "e •" := (etapp e) (at level 30) : lang_scope.
Open Scope lang_scope.
(* typing rules *)
Reserved Notation "[ k | Γ ⊢ e ':::' t ]"
(at level 60, arguments at next level, no associativity).
Inductive types : nat -> env typ -> exp -> typ -> Prop :=
......@@ -433,3 +432,163 @@ Notation "e ↦* e'" := (mstep e e') (at level 60).
Inductive stepP : exp2 -> exp2 -> Prop :=
| stepL e1 e1' e2 (HS : e1 e1') : stepP (e1,e2) (e1',e2).
Section Contexts.
(** ** Contexts
TODO
*)
Inductive cont : Set :=
| chole : cont
| cpair1 : cont -> exp -> cont
| cpair2 : exp -> cont -> cont
| cfst : cont -> cont
| csnd : cont -> cont
| cinl : cont -> cont
| cinr : cont -> cont
| ccase1 : cont -> exp -> exp -> cont
| ccase2 : exp -> cont -> exp -> cont
| ccase3 : exp -> exp -> cont -> cont
| clam : cont -> cont
| capp1 : cont -> exp -> cont
| capp2 : exp -> cont -> cont
| ctlam : cont -> cont
| ctapp : cont -> cont
| cpack : cont -> cont
| cunpack1 : cont -> exp -> cont
| cunpack2 : exp -> cont -> cont
| cfold : cont -> cont
| cunfold : cont -> cont.
(** Substituting a term for the hole in a context: *)
Fixpoint csubst (C : cont) (e' : exp) :=
match C with
| chole => e'
| cpair1 C eR => epair (csubst C e') eR
| cpair2 eL C => epair eL (csubst C e')
| cfst C => efst (csubst C e')
| csnd C => esnd (csubst C e')
| cinl C => einl (csubst C e')
| cinr C => einr (csubst C e')
| ccase1 C eL eR => ecase (csubst C e') eL eR
| ccase2 e C eR => ecase e (csubst C e') eR
| ccase3 e eL C => ecase e eL (csubst C e')
| clam C => elam (csubst C e')
| capp1 C ea => eapp (csubst C e') ea
| capp2 e C => eapp e (csubst C e')
| ctlam C => etlam (csubst C e')
| ctapp C => etapp (csubst C e')
| cpack C => epack (csubst C e')
| cunpack1 C ep => eunpack (csubst C e') ep
| cunpack2 e C => eunpack e (csubst C e')
| cfold C => efold (csubst C e')
| cunfold C => eunfold (csubst C e')
end.
(**
The typing relation for contexts: in [ctypes C (k, Γ, t) (k', Γ', t')],
the intended semantics is that for any [e] with [ [ k | Γ e ::: t ] ],
we get that [ [ k' | Γ' csubst C e ::: t' ] ]. We also prove this as a lemma.
*)
Inductive ctypes : cont -> (nat * env typ * typ) -> (nat * env typ * typ) -> Prop :=
| CThole : forall k Γ t
(HC1: closed k Γ)
(HC: closed k t),
ctypes chole (k, Γ, t) (k, Γ, t)
| CTpair1 : forall C k k' Γ Γ' t t1 t2 eR
(HCT: ctypes C (k, Γ, t) (k', Γ', t1))
(HT: [ k' | Γ' eR ::: t2 ]),
ctypes (cpair1 C eR) (k, Γ, t) (k', Γ', t1 × t2)
| CTpair2 : forall C k k' Γ Γ' t t1 t2 eL
(HT: [ k' | Γ' eL ::: t1 ])
(HCT: ctypes C (k, Γ, t) (k', Γ', t2)),
ctypes (cpair2 eL C) (k, Γ, t) (k', Γ', t1 × t2)
| CTfst : forall C k k' Γ Γ' t t1 t2
(HCT: ctypes C (k, Γ, t) (k', Γ', t1 × t2)),
ctypes (cfst C) (k, Γ, t) (k', Γ', t1)
| CTsnd : forall C k k' Γ Γ' t t1 t2
(HCT: ctypes C (k, Γ, t) (k', Γ', t1 × t2)),
ctypes (csnd C) (k, Γ, t) (k', Γ', t2)
| CTinl : forall C k k' Γ Γ' t t1 t2
(HCT: ctypes C (k, Γ, t) (k', Γ', t1))
(HC: closed k' t2),
ctypes (cinl C) (k, Γ, t) (k', Γ', t1 + t2)
| CTinr : forall C k k' Γ Γ' t t1 t2
(HCT: ctypes C (k, Γ, t) (k', Γ', t2))
(HC: closed k' t1),
ctypes (cinr C) (k, Γ, t) (k', Γ', t1 + t2)
| CTcase1 : forall C k k' Γ Γ' t t1 t2 t' eL eR
(HCT: ctypes C (k, Γ, t) (k', Γ', t1 + t2))
(HTL: [ k' | insert 0 t1 Γ' eL ::: t' ])
(HTR: [ k' | insert 0 t2 Γ' eR ::: t' ]),
ctypes (ccase1 C eL eR) (k, Γ, t) (k', Γ', t')
| CTcase2 : forall C k k' Γ Γ' t t1 t2 t' e eR
(HT: [ k' | Γ' e ::: t1 + t2 ])
(HCT: ctypes C (k, Γ, t) (k', insert 0 t1 Γ', t'))
(HTR: [ k' | insert 0 t2 Γ' eR ::: t' ]),
ctypes (ccase2 e C eR) (k, Γ, t) (k', Γ', t')
| CTcase3 : forall C k k' Γ Γ' t t1 t2 t' e eL
(HT: [ k' | Γ' e ::: t1 + t2 ])
(HTR: [ k' | insert 0 t1 Γ' eL ::: t' ])
(HCT: ctypes C (k, Γ, t) (k', insert 0 t2 Γ', t')),
ctypes (ccase3 e eL C) (k, Γ, t) (k', Γ', t')
| CTLam : forall C k k' Γ Γ' t t1 t2
(HCT: ctypes C (k, Γ, t) (k', insert 0 t1 Γ', t2)),
ctypes (clam C) (k, Γ, t) (k', Γ', t1 t2)
| CTApp1 : forall C k k' Γ Γ' t t2 t' ea
(HCT: ctypes C (k, Γ, t) (k', Γ', t2 t'))
(HT: [ k' | Γ' ea ::: t2 ]),
ctypes (capp1 C ea) (k, Γ, t) (k', Γ', t')
| CTApp2 : forall C k k' Γ Γ' t t2 t' e
(HT: [ k' | Γ' e ::: t2 t' ])
(HCT : ctypes C (k, Γ, t) (k', Γ', t2)),
ctypes (capp2 e C) (k, Γ, t) (k', Γ', t')
| CTTLam : forall C k k' Γ Γ' t t'
(HCT: ctypes C (k, Γ, t) (S k', shift 0 Γ', t')),
ctypes (ctlam C) (k, Γ, t) (k', Γ', t')
| CTTapp : forall C k k' Γ Γ' (t t1 t2 t' : typ)
(HCT: ctypes C (k, Γ, t) (k', Γ', t1))
(HC: closed k' t2)
(HS: subst t2 0 t1 = t'),
ctypes (ctapp C) (k, Γ, t) (k', Γ', t')
| CTPack : forall C k k' Γ Γ' t t1 t'
(HCT: ctypes C (k, Γ, t) (k', Γ', subst t1 0 t'))
(HC: closed (S k') t')
(HC1: closed k' t1),
ctypes (cpack C) (k, Γ, t) (k', Γ', t')
| CTUnpack1 : forall C k k' Γ Γ' t t1 t' ep
(HCT: ctypes C (k, Γ, t) (k', Γ', t1))
(HT: [ S k' | insert 0 t1 (shift 0 Γ') ep ::: shift 0 t' ])
(HC: closed k' t'),
ctypes (cunpack1 C ep) (k, Γ, t) (k', Γ', t')
| CTUnpack2 : forall C k k' Γ Γ' t t1 t' e
(HT: [ k' | Γ' e ::: t1 ])
(HCT: ctypes C (k, Γ, t) (S k', insert 0 t1 (shift 0 Γ'), shift 0 t'))
(HC: closed k' t'),
ctypes (cunpack2 e C) (k, Γ, t) (k', Γ', t')
| CTFold : forall C k k' Γ Γ' t t'
(HCT: ctypes C (k, Γ, t) (k', Γ', subst (μ t') 0 t'))
(HC: closed (S k') t'),
ctypes (cfold C) (k, Γ, t) (k', Γ', μ t')
| CTUnfold : forall C k k' Γ Γ' t t1 t'
(HCT: ctypes C (k, Γ, t) (k', Γ', μ t1))
(HS: subst (μ t1) 0 t1 = t'),
ctypes (cunfold C) (k, Γ, t) (k', Γ', t').
End Contexts.
Lemma csubst_type : forall {C k k' Γ Γ' t t' e}
(HCT: ctypes C (k, Γ, t) (k', Γ', t'))
(HT: [ k | Γ e ::: t ]),
[ k' | Γ' csubst C e ::: t' ].
Proof.
induction C; intros; simpl; inversion HCT; subst; eauto using types.
Qed.
......@@ -194,6 +194,48 @@ Section Closedness.
Definition types_closed_e {k Γ t e} (HT : [k | Γ e ::: t]) : closed (length Γ) e :=
proj2 (proj2 (types_closed HT)).
(**
For the proof of the Soundness property we are going to need the "semantic version"
of the [csubst_type] lemma, which is going to be a compatibility lemma for (well-typed)
contexts:
whenever [logrel k Γ e1 e2 t], we also have [logrel k' Γ' (csubst C e1) (csubst C e2) t'].
As with the original compatibility lemmas, there is first a more technical lemma
about the closedness of types occuring in the typing relation for contexts:
*)
Lemma ctypes_closed : forall {C k k' Γ Γ' t t'}
(HCT: ctypes C (k, Γ, t) (k', Γ', t')),
closed k' Γ' /\ closed k' t'.
Proof.
induction C; intros; simpl; inversion HCT; subst; eauto.
apply IHC in HCT0. intuition. apply types_closed_t in HT. construction_closed.
apply IHC in HCT0. intuition. apply types_closed_t in HT. construction_closed.
apply IHC in HCT0. intuition. inversion_closed. assumption.
apply IHC in HCT0. intuition. inversion_closed. assumption.
apply IHC in HCT0. intuition. construction_closed.
apply IHC in HCT0. intuition. construction_closed.
apply IHC in HCT0. apply types_closed_t in HTL. intuition.
apply IHC in HCT0. intuition. inversion_closed. construction_closed.
apply IHC in HCT0. intuition. inversion_closed. construction_closed.
apply IHC in HCT0. intuition; inversion_closed; construction_closed.
apply IHC in HCT0. intuition. inversion_closed. assumption.
apply IHC in HCT0. apply types_closed_t in HT. intuition. inversion_closed; assumption.
apply IHC in HCT0. intuition. inversion_closed.
apply fold_closed in H; erewrite <- lift_preserves_closed_iff in H.
assumption. construction_closed.
apply IHC in HCT0. intuition. inversion_closed. eapply subst_preserves_closed; auto. apply _.
apply IHC in HCT0. intuition. inversion_closed. construction_closed.
apply IHC in HCT0. intuition.
apply IHC in HCT0. apply types_closed in HT. intuition.
apply IHC in HCT0. intuition. construction_closed.
apply IHC in HCT0. intuition. inversion_closed.
eapply subst_preserves_closed. apply _. construction_closed. assumption.
Qed.
Definition ctypes_closed_t {C k k' Γ Γ' t t'} (HCT: ctypes C (k, Γ, t) (k', Γ', t')) :=
proj2 (ctypes_closed HCT).
Lemma val_to_exp_inj (v1 v2 : val) (EQ : (v1 : exp) = (v2 : exp)) : v1 = v2.
Proof.
revert v2 EQ; induction v1; destruct v2; intros; inversion EQ; subst; auto with f_equal.
......
......@@ -89,7 +89,6 @@ endif
######################
VFILES:=BinaryTyped/SyntacticMinimalInvariance.v\
BinaryTyped/Soundness.v\
BinaryTyped/Compatibility.v\
BinaryTyped/WeakSub.v\
BinaryTyped/LogRel.v\
......@@ -97,7 +96,6 @@ VFILES:=BinaryTyped/SyntacticMinimalInvariance.v\
Binary/Parametricity.v\
Binary/Queues.v\
Binary/QueueDefinitions.v\
Binary/Soundness.v\
Binary/Compatibility.v\
Binary/WeakSub.v\
Binary/LogRel.v\
......
......@@ -13,7 +13,6 @@ Unary/Compatibility.v
Binary/LogRel.v
Binary/WeakSub.v
Binary/Compatibility.v
Binary/Soundness.v
Binary/QueueDefinitions.v
Binary/Queues.v
Binary/Parametricity.v
......@@ -22,5 +21,4 @@ BinaryTyped/WeakSubSyntactic.v
BinaryTyped/LogRel.v
BinaryTyped/WeakSub.v
BinaryTyped/Compatibility.v
BinaryTyped/Soundness.v
BinaryTyped/SyntacticMinimalInvariance.v
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment