Permalink
Fetching contributors…
Cannot retrieve contributors at this time
7209 lines (6479 sloc) 281 KB
(* Full safety for DOT *)
(* copied from dot22.v *)
(* based on that, it removes the 2nd level of pushback,
and performs the necessary translation while going
from stp to stp2 *)
(* copied from dot23.v *)
(* based on that, it adds bind1 rule *)
Require Export SfLib.
Require Export Arith.EqNat.
Require Export Arith.Le.
Require Import Coq.Program.Equality.
Module FSUB.
Definition id := nat.
Inductive var : Type :=
| varF : id -> var
| varH : id -> var
| varB : id -> var
.
Inductive ty : Type :=
| TBool : ty
| TBot : ty
| TTop : ty
| TMem : id -> ty -> ty -> ty
| TSel : var -> id -> ty
| TAll : id -> ty -> ty -> ty
| TBind : ty -> ty
| TAnd : ty -> ty -> ty
| TOr : ty -> ty -> ty
.
Inductive tm : Type :=
| ttrue : tm
| tfalse : tm
| tvar : id -> tm
| tapp : tm -> id -> tm -> tm (* \o.m(x) *)
| tobj : id -> list (id * def) -> tm (* \o {d} *)
| tlet : id -> tm -> tm -> tm (* let \x = t1 in t2 *)
with def : Type :=
| dfun : id -> tm -> def
| dmem : ty -> def
.
Inductive vl : Type :=
| vbool : bool -> vl
| vobj : list (id*vl) -> id -> list (id * def) -> vl
.
Definition tenv := list (id*ty).
Definition venv := list (id*vl).
Definition aenv := list (id*(venv*ty)).
Hint Unfold venv.
Hint Unfold tenv.
Fixpoint fresh {X: Type} (l : list (id * X)): nat :=
match l with
| [] => 0
| (n',a)::l' => 1 + n'
end.
Fixpoint index {X : Type} (n : id) (l : list (id * X)) : option X :=
match l with
| [] => None
| (n',a) :: l' =>
if le_lt_dec (fresh l') n' then
if (beq_nat n n') then Some a else index n l'
else None
end.
Fixpoint indexr {X : Type} (n : id) (l : list (id * X)) : option X :=
match l with
| [] => None
| (n',a) :: l' => (* DeBrujin *)
if (beq_nat n (length l')) then Some a else indexr n l'
end.
Fixpoint tailr {X : Type} (n : id) (l : list (id * X)) : list (id * X) :=
match l with
| [] => []
| (n',a) :: l' => (* DeBrujin *)
if (beq_nat n (length l)) then l else tailr n l'
end.
(*
Fixpoint update {X : Type} (n : nat) (x: X)
(l : list X) { struct l }: list X :=
match l with
| [] => []
| a :: l' => if beq_nat n (length l') then x::l' else a :: update n x l'
end.
*)
(* LOCALLY NAMELESS *)
Inductive closed_rec: nat -> nat -> ty -> Prop :=
| cl_top: forall k l,
closed_rec k l TTop
| cl_bot: forall k l,
closed_rec k l TBot
| cl_bool: forall k l,
closed_rec k l TBool
| cl_mem: forall k l m T1 T2,
closed_rec k l T1 ->
closed_rec k l T2 ->
closed_rec k l (TMem m T1 T2)
| cl_all: forall k l m T1 T2,
closed_rec k l T1 ->
closed_rec (S k) l T2 ->
closed_rec k l (TAll m T1 T2)
| cl_bind: forall k l T2,
closed_rec (S k) l T2 ->
closed_rec k l (TBind T2)
| cl_sel: forall k l x m,
closed_rec k l (TSel (varF x) m)
| cl_and: forall k l T1 T2,
closed_rec k l T1 ->
closed_rec k l T2 ->
closed_rec k l (TAnd T1 T2)
| cl_or: forall k l T1 T2,
closed_rec k l T1 ->
closed_rec k l T2 ->
closed_rec k l (TOr T1 T2)
| cl_selh: forall k l x m,
l > x ->
closed_rec k l (TSel (varH x) m)
| cl_selb: forall k l i m,
k > i ->
closed_rec k l (TSel (varB i) m)
.
Hint Constructors closed_rec.
Definition closed j l T := closed_rec j l T.
Fixpoint open_rec (k: nat) (u: var) (T: ty) { struct T }: ty :=
match T with
| TSel (varF x) m => TSel (varF x) m (* free var remains free. functional, so we can't check for conflict *)
| TSel (varH i) m => TSel (varH i) m
| TSel (varB i) m => TSel (if beq_nat k i then u else varB i) m
| TAll m T1 T2 => TAll m (open_rec k u T1) (open_rec (S k) u T2)
| TBind T2 => TBind (open_rec (S k) u T2)
| TTop => TTop
| TBot => TBot
| TBool => TBool
| TMem m T1 T2 => TMem m (open_rec k u T1) (open_rec k u T2)
| TAnd T1 T2 => TAnd (open_rec k u T1) (open_rec k u T2)
| TOr T1 T2 => TOr (open_rec k u T1) (open_rec k u T2)
end.
Definition open u T := open_rec 0 u T.
(* sanity check *)
Example open_ex1: open (varF 9) (TAll 0 TBool (TAll 0 (TSel (varB 1) 0) (TSel (varB 1) 0))) =
(TAll 0 TBool (TAll 0 (TSel (varF 9) 0) (TSel (varB 1) 0))).
Proof. compute. eauto. Qed.
Fixpoint subst (U : var) (T : ty) {struct T} : ty :=
match T with
| TTop => TTop
| TBot => TBot
| TBool => TBool
| TMem m T1 T2 => TMem m (subst U T1) (subst U T2)
| TSel (varB i) m => TSel (varB i) m
| TSel (varF i) m => TSel (varF i) m
| TSel (varH i) m => TSel (if beq_nat i 0 then U else varH (i-1)) m
| TAll m T1 T2 => TAll m (subst U T1) (subst U T2)
| TBind T2 => TBind (subst U T2)
| TAnd T1 T2 => TAnd (subst U T1) (subst U T2)
| TOr T1 T2 => TOr (subst U T1) (subst U T2)
end.
Fixpoint nosubst (T : ty) {struct T} : Prop :=
match T with
| TTop => True
| TBot => True
| TBool => True
| TMem m T1 T2 => nosubst T1 /\ nosubst T2
| TSel (varB i) m => True
| TSel (varF i) m => True
| TSel (varH i) m => i <> 0
| TAll m T1 T2 => nosubst T1 /\ nosubst T2
| TBind T2 => nosubst T2
| TAnd T1 T2 => nosubst T1 /\ nosubst T2
| TOr T1 T2 => nosubst T1 /\ nosubst T2
end.
Hint Unfold open.
Hint Unfold closed.
(* TODO: var *)
(* QUESTION: include trans rule or not? sela1 rules use restricted GL now, so trans seems useful *)
Inductive stp: tenv -> tenv -> ty -> ty -> Prop :=
| stp_topx: forall G1 GH,
stp G1 GH TTop TTop
| stp_botx: forall G1 GH,
stp G1 GH TBot TBot
| stp_top: forall G1 GH T1,
stp G1 GH T1 T1 -> (* regularity *)
stp G1 GH T1 TTop
| stp_bot: forall G1 GH T2,
stp G1 GH T2 T2 -> (* regularity *)
stp G1 GH TBot T2
| stp_bool: forall G1 GH,
stp G1 GH TBool TBool
| stp_mem: forall G1 GH m T1 T2 T3 T4,
stp G1 GH T3 T1 ->
stp G1 GH T2 T4 ->
stp G1 GH (TMem m T1 T2) (TMem m T3 T4)
| stp_sel1: forall G1 GH TX m T2 x,
index x G1 = Some TX ->
closed 0 0 TX ->
stp G1 [] TX (TMem m TBot T2) ->
stp G1 GH T2 T2 -> (* regularity of stp2 *)
stp G1 GH (TSel (varF x) m) T2
| stp_sel2: forall G1 GH TX m T1 x,
index x G1 = Some TX ->
closed 0 0 TX ->
stp G1 [] TX (TMem m T1 TTop) ->
stp G1 GH T1 T1 -> (* regularity of stp2 *)
stp G1 GH T1 (TSel (varF x) m)
| stp_selb1: forall G1 GH TX m T2 x,
index x G1 = Some TX ->
stp G1 [] TX (TBind (TMem m TBot T2)) -> (* Note GH = [] *)
stp G1 GH (open (varF x) T2) (open (varF x) T2) -> (* regularity *)
stp G1 GH (TSel (varF x) m) (open (varF x) T2)
| stp_selb2: forall G1 GH TX m T1 x,
index x G1 = Some TX ->
stp G1 [] TX (TBind (TMem m T1 TTop)) -> (* Note GH = [] *)
stp G1 GH (open (varF x) T1) (open (varF x) T1) -> (* regularity *)
stp G1 GH (open (varF x) T1) (TSel (varF x) m)
| stp_selx: forall G1 GH TX x m,
index x G1 = Some TX ->
stp G1 GH (TSel (varF x) m) (TSel (varF x) m)
| stp_sela1: forall G1 GH GL TX m T2 x,
tailr (S x) GH = (0,TX)::GL ->
stp G1 ((0,TX)::GL) TX (TMem m TBot T2) ->
stp G1 GH T2 T2 -> (* regularity *)
stp G1 GH (TSel (varH x) m) T2
| stp_sela2: forall G1 GH GL TX m T1 x,
tailr (S x) GH = (0,TX)::GL ->
stp G1 ((0,TX)::GL) TX (TMem m T1 TTop) -> (* not using self name for now *)
stp G1 GH T1 T1 -> (* regularity of stp2 *)
stp G1 GH T1 (TSel (varH x) m)
| stp_selab1: forall G1 GH GL TX m T2 T2' x,
tailr (S x) GH = (0,TX)::GL ->
closed 0 x (TBind (TMem m TBot T2)) ->
stp G1 ((0,TX)::GL) TX (TBind (TMem m TBot T2)) ->
T2' = (open (varH x) T2) ->
stp G1 GH T2' T2' -> (* regularity *)
stp G1 GH (TSel (varH x) m) T2'
| stp_selab2: forall G1 GH GL TX m T1 T1' x,
tailr (S x) GH = (0,TX)::GL ->
closed 0 x (TBind (TMem m T1 TTop)) ->
stp G1 ((0,TX)::GL) TX (TBind (TMem m T1 TTop)) ->
T1' = (open (varH x) T1) ->
stp G1 GH T1' T1' -> (* regularity *)
stp G1 GH T1' (TSel (varH x) m)
| stp_selax: forall G1 GH TX x m,
indexr x GH = Some TX ->
stp G1 GH (TSel (varH x) m) (TSel (varH x) m)
| stp_all: forall G1 GH m T1 T2 T3 T4 x,
stp G1 GH T3 T1 ->
x = length GH ->
closed 1 (length GH) T2 -> (* must not accidentally bind x *)
closed 1 (length GH) T4 ->
stp G1 ((0,T1)::GH) (open (varH x) T2) (open (varH x) T2) -> (* regularity *)
stp G1 ((0,T3)::GH) (open (varH x) T2) (open (varH x) T4) ->
stp G1 GH (TAll m T1 T2) (TAll m T3 T4)
| stp_bindx: forall G1 GH T1 T2 x,
x = length GH ->
closed 1 (length GH) T1 -> (* must not accidentally bind x *)
closed 1 (length GH) T2 ->
stp G1 ((0,open (varH x) T2)::GH) (open (varH x) T2) (open (varH x) T2) -> (* regularity *)
stp G1 ((0,open (varH x) T1)::GH) (open (varH x) T1) (open (varH x) T2) ->
stp G1 GH (TBind T1) (TBind T2)
| stp_bind1: forall G1 GH T1 T2 x,
x = length GH ->
closed 1 (length GH) T1 -> (* must not accidentally bind x *)
closed 0 (length GH) T2 ->
stp G1 GH T2 T2 ->
stp G1 ((0,open (varH x) T1)::GH) (open (varH x) T1) T2 ->
stp G1 GH (TBind T1) T2
| stp_and11: forall G GH T1 T2 T,
stp G GH T1 T ->
stp G GH T2 T2 -> (* regularity *)
stp G GH (TAnd T1 T2) T
| stp_and12: forall G GH T1 T2 T,
stp G GH T2 T ->
stp G GH T1 T1 -> (* regularity *)
stp G GH (TAnd T1 T2) T
| stp_and2: forall G GH T1 T2 T,
stp G GH T T1 ->
stp G GH T T2 ->
stp G GH T (TAnd T1 T2)
| stp_or21: forall G GH T1 T2 T,
stp G GH T T1 ->
stp G GH T2 T2 -> (* regularity *)
stp G GH T (TOr T1 T2)
| stp_or22: forall G GH T1 T2 T,
stp G GH T T2 ->
stp G GH T1 T1 -> (* regularity *)
stp G GH T (TOr T1 T2)
| stp_or1: forall G GH T1 T2 T,
stp G GH T1 T ->
stp G GH T2 T ->
stp G GH (TOr T1 T2) T
.
(*
with path_type: tenv -> tenv -> id -> ty -> Prop :=
| pt_var: forall G1 GH TX x,
index x G1 = Some TX ->
path_type G1 GH x TX
| pt_sub: forall G1 GH TX x,
path_type has_type env e T1 ->
stp env [] T1 T2 ->
has_type env e T2
with pathH_type: tenv -> tenv -> id -> ty -> Prop :=
| pth_var: forall G1 GH TX T x,
indexr x GH = Some TX ->
stp G1 GH TX T ->
pathH_type G1 GH x T
*)
Hint Constructors stp.
Function tand (t1: ty) (t2: ty) :=
match t2 with
| TTop => t1
| _ => TAnd t1 t2
end.
(* TODO *)
Inductive has_type : tenv -> tm -> ty -> Prop :=
| t_true: forall env,
has_type env ttrue TBool
| t_false: forall env,
has_type env tfalse TBool
| t_var: forall x env T1,
index x env = Some T1 ->
stp env [] T1 T1 ->
has_type env (tvar x) T1
| t_var_pack: forall x env T1,
has_type env (tvar x) (open (varF x) T1) ->
stp env [] (TBind T1) (TBind T1) ->
has_type env (tvar x) (TBind T1)
| t_var_unpack: forall x env T1,
has_type env (tvar x) (TBind T1) ->
stp env [] (open (varF x) T1) (open (varF x) T1) ->
has_type env (tvar x) (open (varF x) T1)
| t_obj: forall env f ds T TX,
fresh env = f ->
open (varF f) T = TX ->
dcs_has_type ((f, TX)::env) f ds T ->
stp ((f, TX)::env) [] TX TX ->
stp env [] (TBind T) (TBind T) ->
has_type env (tobj f ds) (TBind T)
| t_app: forall env f l x T1 T2,
has_type env f (TAll l T1 T2) ->
has_type env x T1 ->
stp env [] T2 T2 ->
has_type env (tapp f l x) T2
| t_app_var: forall env f l x T1 T2 T2X,
has_type env f (TAll l T1 T2) ->
has_type env (tvar x) T1 ->
open (varF x) T2 = T2X ->
stp env [] T2X T2X ->
has_type env (tapp f l (tvar x)) T2X
| t_let: forall env x ex e Tx T,
has_type env ex Tx ->
fresh env <= x ->
has_type ((x, Tx)::env) e T ->
stp env [] T T ->
has_type env (tlet x ex e) T
| t_sub: forall env e T1 T2,
has_type env e T1 ->
stp env [] T1 T2 ->
has_type env e T2
with dcs_has_type: tenv -> id -> list (id * def) -> ty -> Prop :=
| dt_nil: forall env f,
dcs_has_type env f nil TTop
| dt_fun: forall env f x y m T1 T2 dcs TS T,
has_type ((x,open (varF f) T1)::env) y (open (varF x) (open_rec 1 (varF f) T2)) ->
dcs_has_type env f dcs TS ->
fresh env = x ->
m = length dcs ->
T = tand (TAll m T1 T2) TS ->
dcs_has_type env f ((m, dfun x y)::dcs) T
| dt_mem: forall env f m T1 dcs TS T,
dcs_has_type env f dcs TS ->
m = length dcs ->
T = tand (TMem m T1 T1) TS ->
dcs_has_type env f ((m, dmem T1)::dcs) T
.
Definition MAX := 1.
Inductive stp2: nat -> bool -> venv -> ty -> venv -> ty -> list (id*(venv*ty)) -> nat -> Prop :=
| stp2_topx: forall m G1 G2 GH n1,
stp2 m true G1 TTop G2 TTop GH (S n1)
| stp2_botx: forall m G1 G2 GH n1,
stp2 m true G1 TBot G2 TBot GH (S n1)
| stp2_top: forall m G1 G2 GH T n1,
stp2 m true G1 T G1 T GH n1 -> (* regularity *)
stp2 m true G1 T G2 TTop GH (S n1)
| stp2_bot: forall m G1 G2 GH T n1,
stp2 m true G2 T G2 T GH n1 -> (* regularity *)
stp2 m true G1 TBot G2 T GH (S n1)
| stp2_bool: forall m G1 G2 GH n1,
stp2 m true G1 TBool G2 TBool GH (S n1)
| stp2_mem: forall G1 G2 l T1 T2 T3 T4 GH n1 n2,
stp2 0 false G2 T3 G1 T1 GH n1 ->
stp2 0 true G1 T2 G2 T4 GH n2 ->
stp2 0 true G1 (TMem l T1 T2) G2 (TMem l T3 T4) GH (S (n1+n2))
| stp2_mem2: forall m G1 G2 l T1 T2 T3 T4 GH n1 n2,
stp2 (S m) false G2 T3 G1 T1 GH n1 ->
stp2 (S m) false G1 T2 G2 T4 GH n2 ->
stp2 (S m) true G1 (TMem l T1 T2) G2 (TMem l T3 T4) GH (S (n1+n2))
(* strong version, with precise/invertible bounds *)
| stp2_strong_sel1: forall G1 G2 GX l f ds TX x T2 GH GX' TX' n1 n2,
index x G1 = Some (vobj GX f ds) ->
val_type GX' (vobj GX f ds) TX' 1 -> (* for downgrade *)
stp2 0 false GX' TX' G2 (TMem l TBot T2) GH n2 -> (* for downgrade *)
index l ds = Some (dmem TX) ->
closed 1 0 TX ->
stp2 0 true ((f, vobj GX f ds)::GX) (open (varF f) TX) G2 T2 GH n1 ->
stp2 0 true G1 (TSel (varF x) l) G2 T2 GH (S (n1+n2))
| stp2_strong_sel2: forall G1 G2 GX l f ds TX x T1 GH GX' TX' n1 n2,
index x G2 = Some (vobj GX f ds) ->
val_type GX' (vobj GX f ds) TX' 1 -> (* for downgrade *)
stp2 0 false GX' TX' G1 (TMem l T1 TTop) GH n2 -> (* for downgrade *)
index l ds = Some (dmem TX) ->
closed 1 0 TX ->
stp2 0 false G1 T1 ((f, vobj GX f ds)::GX) (open (varF f) TX) GH n1 ->
stp2 0 true G1 T1 G2 (TSel (varF x) l) GH (S (n1+n2))
| stp2_strong_selx: forall G1 G2 l v x1 x2 GH n1,
index x1 G1 = Some v ->
index x2 G2 = Some v ->
stp2 0 true G1 (TSel (varF x1) l) G2 (TSel (varF x2) l) GH n1
(* existing object, but imprecise type *)
| stp2_sel1: forall m G1 G2 GX l TX x T2 GH n1 n2 v,
index x G1 = Some v ->
val_type GX v TX 1 ->
closed 0 0 TX ->
stp2 (S m) false GX TX G2 (TMem l TBot T2) GH n1 ->
stp2 (S m) true G2 T2 G2 T2 GH n2 -> (* regularity *)
stp2 (S m) true G1 (TSel (varF x) l) G2 T2 GH (S (n1+n2))
(*
| stp2_selb1: forall m G1 G2 GX l TX x x' T2 GH n1 n2 v nv,
index x G1 = Some v -> (index x' G2 = Some v \/ closed 0 0 T2) ->
val_type GX v TX nv ->
closed 0 0 TX ->
stp2 (S ( m)) false GX TX G2 (TBind (TMem l TBot T2)) [] n1 -> (* Note GH = [] *)
stp2 (S ( m)) true G2 (open (varF x') T2) G2 (open (varF x') T2) GH n2 -> (* regularity *)
stp2 (S ( m)) true G1 (TSel (varF x) l) G2 (open (varF x') T2) GH (S (n1+n2))
*)
| stp2_sel2: forall m G1 G2 GX l TX x T1 GH n1 n2 v,
index x G2 = Some v ->
val_type GX v TX 1 ->
closed 0 0 TX ->
stp2 (S m) false GX TX G1 (TMem l T1 TTop) GH n1 ->
stp2 (S m) true G1 T1 G1 T1 GH n2 -> (* regularity *)
stp2 (S m) true G1 T1 G2 (TSel (varF x) l) GH (S (n1+n2))
(*
| stp2_selb2: forall m G1 G2 GX l TX x x' T1 GH n1 n2 v nv,
index x G2 = Some v -> (index x' G1 = Some v \/ closed 0 0 T1) ->
val_type GX v TX nv ->
closed 0 0 TX ->
stp2 (S ( m)) false GX TX G1 (TBind (TMem l T1 TTop)) [] n1 -> (* Note GH = [] *)
stp2 (S ( m)) true G1 (open (varF x') T1) G1 (open (varF x') T1) GH n2 -> (* regularity *)
stp2 (S ( m)) true G1 (open (varF x') T1) G2 (TSel (varF x) l) GH (S (n1+n2))
*)
| stp2_selx: forall m G1 G2 l v x1 x2 GH n1,
index x1 G1 = Some v ->
index x2 G2 = Some v ->
stp2 (S m) true G1 (TSel (varF x1) l) G2 (TSel (varF x2) l) GH (S n1)
(* hypothetical object *)
(*| stp2_sela1: forall m G1 G2 GX l TX x T2 GH n1 n2,
indexr x GH = Some (GX, TX) ->
closed 0 (S x) TX ->
stp2 (S m) false GX TX G2 (TMem l TBot T2) GH n1 ->
stp2 (S m) true G2 T2 G2 T2 GH n2 -> (* regularity *)
stp2 (S m) true G1 (TSel (varH x) l) G2 T2 GH (S (n1+n2))
*)
| stp2_sela1: forall m G1 G2 GX l TX x T2 GH GU GL n1 n2,
indexr x GH = Some (GX, TX) ->
closed 0 (S x) TX ->
length GL = (S x) ->
GH = GU ++ GL ->
stp2 (S m) false GX TX G2 (TMem l TBot T2) GL n1 ->
stp2 (S m) true G2 T2 G2 T2 GH n2 -> (* regularity *)
stp2 (S m) true G1 (TSel (varH x) l) G2 T2 GH (S (n1+n2))
| stp2_sela2: forall m G1 G2 GX l TX x T1 GH GU GL n1 n2,
indexr x GH = Some (GX, TX) ->
closed 0 (S x) TX ->
length GL = (S x) ->
GH = GU ++ GL ->
stp2 (S m) false GX TX G1 (TMem l T1 TTop) GL n1 ->
stp2 (S m) true G1 T1 G1 T1 GH n2 -> (* regularity *)
stp2 (S m) true G1 T1 G2 (TSel (varH x) l) GH (S (n1+n2))
| stp2_selab1: forall m G1 G2 GX l TX x T2 T2' GH GU GL n1 n2,
indexr x GH = Some (GX, TX) ->
closed 1 x T2 -> (* < x required in substitute *)
length GL = (S x) ->
GH = GU ++ GL ->
stp2 (S m) false GX TX G2 (TBind (TMem l TBot T2)) GL n1 ->
T2' = (open (varH x) T2) ->
stp2 (S m) true G2 T2' G2 T2' GH n2 -> (* regularity *)
stp2 (S m) true G1 (TSel (varH x) l) G2 T2' GH (S (n1+n2))
| stp2_selab2: forall m G1 G2 GX l TX x T1 T1' GH GU GL n1 n2,
indexr x GH = Some (GX, TX) ->
closed 1 x T1 -> (* < x required in substitute *)
length GL = (S x) ->
GH = GU ++ GL ->
stp2 (S m) false GX TX G1 (TBind (TMem l T1 TTop)) GL n1 ->
T1' = (open (varH x) T1) ->
stp2 (S m) true G1 T1' G1 T1' GH n2 -> (* regularity *)
stp2 (S m) true G1 T1' G2 (TSel (varH x) l) GH (S (n1+n2))
| stp2_selax: forall m G1 G2 GX l TX x GH n1,
indexr x GH = Some (GX, TX) ->
stp2 (S m) true G1 (TSel (varH x) l) G2 (TSel (varH x) l) GH (S n1)
| stp2_all: forall m G1 G2 l T1 T2 T3 T4 GH n1 n1' n2,
stp2 1 false G2 T3 G1 T1 GH n1 ->
closed 1 (length GH) T2 -> (* must not accidentally bind x *)
closed 1 (length GH) T4 ->
stp2 1 false G1 (open (varH (length GH)) T2) G1 (open (varH (length GH)) T2) ((0,(G1, T1))::GH) n1' -> (* regularity *)
stp2 1 false G1 (open (varH (length GH)) T2) G2 (open (varH (length GH)) T4) ((0,(G2, T3))::GH) n2 ->
stp2 m true G1 (TAll l T1 T2) G2 (TAll l T3 T4) GH (S (n1+n1'+n2))
| stp2_bind: forall m G1 G2 T1 T2 GH n1 n2,
closed 1 (length GH) T1 -> (* must not accidentally bind x *)
closed 1 (length GH) T2 ->
stp2 1 false G2 (open (varH (length GH)) T2) G2 (open (varH (length GH)) T2) ((0,(G2, open (varH (length GH)) T2))::GH) n2 -> (* regularity *)
stp2 1 false G1 (open (varH (length GH)) T1) G2 (open (varH (length GH)) T2) ((0,(G1, open (varH (length GH)) T1))::GH) n1 ->
stp2 m true G1 (TBind T1) G2 (TBind T2) GH (S (n1+n2))
| stp2_bind1: forall m G1 G2 T1 T2 GH n1 n2,
closed 1 (length GH) T1 -> (* must not accidentally bind x *)
closed 0 (length GH) T2 ->
stp2 m false G2 T2 G2 T2 GH n2 -> (* regularity *)
stp2 1 false G1 (open (varH (length GH)) T1) G2 T2 ((0,(G1, open (varH (length GH)) T1))::GH) n1 ->
stp2 m true G1 (TBind T1) G2 T2 GH (S (n1+n2))
| stp2_and11: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m true G1 T1 G2 T GH n1 ->
stp2 m true G1 T2 G1 T2 GH n2 -> (* regularity *)
stp2 m true G1 (TAnd T1 T2) G2 T GH (S (n1+n2))
| stp2_and12: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m true G1 T2 G2 T GH n1 ->
stp2 m true G1 T1 G1 T1 GH n2 -> (* regularity *)
stp2 m true G1 (TAnd T1 T2) G2 T GH (S (n1+n2))
| stp2_and2: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m false G1 T G2 T1 GH n1 ->
stp2 m false G1 T G2 T2 GH n2 ->
stp2 m true G1 T G2 (TAnd T1 T2) GH (S (n1+n2))
| stp2_or21: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m false G1 T G2 T1 GH n1 ->
stp2 m true G2 T2 G2 T2 GH n2 -> (* regularity *)
stp2 m true G1 T G2 (TOr T1 T2) GH (S (n1+n2))
| stp2_or22: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m false G1 T G2 T2 GH n1 ->
stp2 m true G2 T1 G2 T1 GH n2 -> (* regularity *)
stp2 m true G1 T G2 (TOr T1 T2) GH (S (n1+n2))
| stp2_or1: forall m n1 n2 G1 G2 GH T1 T2 T,
stp2 m true G1 T1 G2 T GH n1 ->
stp2 m true G1 T2 G2 T GH n2 ->
stp2 m true G1 (TOr T1 T2) G2 T GH (S (n1+n2))
| stp2_wrapf: forall m G1 G2 T1 T2 GH n1,
stp2 m true G1 T1 G2 T2 GH n1 ->
stp2 m false G1 T1 G2 T2 GH (S n1)
| stp2_transf: forall m G1 G2 G3 T1 T2 T3 GH n1 n2,
stp2 m true G1 T1 G2 T2 GH n1 ->
stp2 m false G2 T2 G3 T3 GH n2 ->
stp2 m false G1 T1 G3 T3 GH (S (n1+n2))
with wf_env : venv -> tenv -> Prop :=
| wfe_nil : wf_env nil nil
| wfe_cons : forall n v t vs ts nv,
val_type ((n,v)::vs) v t nv ->
wf_env vs ts ->
wf_env (cons (n,v) vs) (cons (n,t) ts)
with val_type : venv -> vl -> ty -> nat -> Prop :=
| v_bool: forall venv b TE,
(exists n, stp2 0 true [] TBool venv TE [] n) ->
val_type venv (vbool b) TE 1
| v_obj: forall env venv tenv f ds T TX TE,
wf_env venv tenv ->
open (varF f) T = TX ->
dcs_has_type ((f,TX)::tenv) f ds T ->
fresh venv = f ->
(exists n, stp2 0 true ((f, vobj venv f ds)::venv) TX env TE [] n)->
val_type env (vobj venv f ds) TE 1
| v_pack: forall venv venv3 x v T T2 T3 n,
index x venv = Some v ->
val_type venv v T n ->
open (varF x) T2 = T ->
(exists n, stp2 0 true venv (TBind T2) venv3 T3 [] n) ->
val_type venv3 v T3 (S n)
.
Inductive wf_envh : venv -> aenv -> tenv -> Prop :=
| wfeh_nil : forall vvs, wf_envh vvs nil nil
| wfeh_cons : forall n t vs vvs ts,
wf_envh vvs vs ts ->
wf_envh vvs (cons (n,(vvs,t)) vs) (cons (n,t) ts)
.
Inductive valh_type : venv -> aenv -> (venv*ty) -> ty -> Prop :=
| v_tya: forall aenv venv T1,
valh_type venv aenv (venv, T1) T1
.
Definition stpd2 b G1 T1 G2 T2 GH := exists n, stp2 MAX b G1 T1 G2 T2 GH n.
Definition sstpd2 b G1 T1 G2 T2 GH := exists n, stp2 0 b G1 T1 G2 T2 GH n.
Definition valtpd G v T := exists n, val_type G v T n.
Ltac ep := match goal with
| [ |- stp2 ?M1 ?M2 ?G1 ?T1 ?G2 ?T2 ?GH ?N ] => assert (exists (x:nat), stp2 M1 M2 G1 T1 G2 T2 GH x) as EEX
end.
Ltac eu := match goal with
| H: stpd2 _ _ _ _ _ _ |- _ => destruct H as [? H]
| H: sstpd2 _ _ _ _ _ _ |- _ => destruct H as [? H]
(* | H: exists n: nat , _ |- _ =>
destruct H as [e P] *)
end.
Hint Constructors stp2.
Hint Unfold stpd2.
Lemma stpd2_topx: forall G1 G2 GH,
stpd2 true G1 TTop G2 TTop GH.
Proof. intros. repeat exists (S 0). eauto. Qed.
Lemma stpd2_botx: forall G1 G2 GH,
stpd2 true G1 TBot G2 TBot GH.
Proof. intros. repeat exists (S 0). eauto. Qed.
Lemma stpd2_top: forall G1 G2 GH T,
stpd2 true G1 T G1 T GH ->
stpd2 true G1 T G2 TTop GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_bot: forall G1 G2 GH T,
stpd2 true G2 T G2 T GH ->
stpd2 true G1 TBot G2 T GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_bool: forall G1 G2 GH,
stpd2 true G1 TBool G2 TBool GH.
Proof. intros. repeat exists (S 0). eauto. Qed.
Lemma stpd2_mem: forall G1 G2 GH l T11 T12 T21 T22,
stpd2 false G2 T21 G1 T11 GH ->
stpd2 false G1 T12 G2 T22 GH ->
stpd2 true G1 (TMem l T11 T12) G2 (TMem l T21 T22) GH.
Proof. intros. repeat eu. eauto. unfold stpd2. eexists. eapply stp2_mem2; eauto. Qed.
Lemma stpd2_sel1: forall G1 G2 GX l TX x T2 GH v,
index x G1 = Some v ->
val_type GX v TX 1 ->
closed 0 0 TX ->
stpd2 false GX TX G2 (TMem l TBot T2) GH ->
stpd2 true G2 T2 G2 T2 GH ->
stpd2 true G1 (TSel (varF x) l) G2 T2 GH.
Proof. intros. repeat eu. eexists. eapply stp2_sel1; eauto. Qed.
(*
Lemma stpd2_selb1: forall G1 G2 GX l TX x x' T2 GH v nv,
index x G1 = Some v -> (index x' G2 = Some v \/ closed 0 0 T2) ->
val_type GX v TX nv ->
closed 0 0 TX ->
stpd2 false GX TX G2 (TBind (TMem l TBot T2)) [] -> (* Note GH = [] *)
stpd2 true G2 (open (varF x') T2) G2 (open (varF x') T2) GH ->
stpd2 true G1 (TSel (varF x) l) G2 (open (varF x') T2) GH.
Proof. intros. repeat eu. eexists. eapply stp2_selb1; eauto. Qed.
*)
Lemma stpd2_sel2: forall G1 G2 GX l TX x T1 GH v,
index x G2 = Some v ->
val_type GX v TX 1 ->
closed 0 0 TX ->
stpd2 false GX TX G1 (TMem l T1 TTop) GH ->
stpd2 true G1 T1 G1 T1 GH ->
stpd2 true G1 T1 G2 (TSel (varF x) l) GH.
Proof. intros. repeat eu. eexists. eapply stp2_sel2; eauto. Qed.
(*
Lemma stpd2_selb2: forall G1 G2 GX l TX x x' T1 GH v nv,
index x G2 = Some v -> (index x' G1 = Some v \/ closed 0 0 T1) ->
val_type GX v TX nv ->
closed 0 0 TX ->
stpd2 false GX TX G1 (TBind (TMem l T1 TTop)) [] -> (* Note GH = [] *)
stpd2 true G1 (open (varF x') T1) G1 (open (varF x') T1) GH ->
stpd2 true G1 (open (varF x') T1) G2 (TSel (varF x) l) GH.
Proof. intros. repeat eu. eexists. eapply stp2_selb2; eauto. Qed.
*)
Lemma stpd2_selx: forall G1 G2 l x1 x2 GH v,
index x1 G1 = Some v ->
index x2 G2 = Some v ->
stpd2 true G1 (TSel (varF x1) l) G2 (TSel (varF x2) l) GH.
Proof. intros. eauto. exists (S 0). eapply stp2_selx; eauto. Qed.
Lemma stpd2_sela1: forall G1 G2 GX l TX x T2 GH GU GL,
indexr x GH = Some (GX, TX) ->
closed 0 (S x) TX ->
length GL = (S x) ->
GH = GU ++ GL ->
stpd2 false GX TX G2 (TMem l TBot T2) GL ->
stpd2 true G2 T2 G2 T2 GH ->
stpd2 true G1 (TSel (varH x) l) G2 T2 GH.
Proof. intros. repeat eu. eauto. eexists. eapply stp2_sela1; eauto. Qed.
Lemma stpd2_sela2: forall G1 G2 GX l TX x T1 GH GU GL,
indexr x GH = Some (GX, TX) ->
closed 0 (S x) TX ->
length GL = (S x) ->
GH = GU ++ GL ->
stpd2 false GX TX G1 (TMem l T1 TTop) GL ->
stpd2 true G1 T1 G1 T1 GH ->
stpd2 true G1 T1 G2 (TSel (varH x) l) GH.
Proof. intros. repeat eu. eauto. eexists. eapply stp2_sela2; eauto. Qed.
Lemma stpd2_selab1: forall G1 G2 GX l TX x T2 T2' GH GU GL,
indexr x GH = Some (GX, TX) ->
closed 1 x T2 ->
length GL = (S x) ->
GH = GU ++ GL ->
stpd2 false GX TX G2 (TBind (TMem l TBot T2)) GL ->
T2' = (open (varH x) T2) ->
stpd2 true G2 T2' G2 T2' GH ->
stpd2 true G1 (TSel (varH x) l) G2 T2' GH.
Proof. intros. repeat eu. eauto. eexists. eapply stp2_selab1; eauto. Qed.
Lemma stpd2_selab2: forall G1 G2 GX l TX x T1 T1' GH GU GL,
indexr x GH = Some (GX, TX) ->
closed 1 x T1 ->
length GL = (S x) ->
GH = GU ++ GL ->
stpd2 false GX TX G1 (TBind (TMem l T1 TTop)) GL ->
T1' = (open (varH x) T1) ->
stpd2 true G1 T1' G1 T1' GH ->
stpd2 true G1 T1' G2 (TSel (varH x) l) GH.
Proof. intros. repeat eu. eauto. eexists. eapply stp2_selab2; eauto. Qed.
Lemma stpd2_selax: forall G1 G2 GX l TX x GH,
indexr x GH = Some (GX, TX) ->
stpd2 true G1 (TSel (varH x) l) G2 (TSel (varH x) l) GH.
Proof. intros. exists (S 0). eauto. eapply stp2_selax; eauto. Qed.
Lemma stpd2_all: forall G1 G2 m T1 T2 T3 T4 GH,
stpd2 false G2 T3 G1 T1 GH ->
closed 1 (length GH) T2 ->
closed 1 (length GH) T4 ->
stpd2 false G1 (open (varH (length GH)) T2) G1 (open (varH (length GH)) T2) ((0,(G1, T1))::GH) ->
stpd2 false G1 (open (varH (length GH)) T2) G2 (open (varH (length GH)) T4) ((0,(G2, T3))::GH) ->
stpd2 true G1 (TAll m T1 T2) G2 (TAll m T3 T4) GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_bind: forall G1 G2 T1 T2 GH,
closed 1 (length GH) T1 ->
closed 1 (length GH) T2 ->
stpd2 false G2 (open (varH (length GH)) T2) G2 (open (varH (length GH)) T2) ((0,(G2, open (varH (length GH)) T2))::GH) ->
stpd2 false G1 (open (varH (length GH)) T1) G2 (open (varH (length GH)) T2) ((0,(G1, open (varH (length GH)) T1))::GH) ->
stpd2 true G1 (TBind T1) G2 (TBind T2) GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_bind1: forall G1 G2 T1 T2 GH,
closed 1 (length GH) T1 -> (* must not accidentally bind x *)
closed 0 (length GH) T2 ->
stpd2 false G2 T2 G2 T2 GH -> (* regularity *)
stpd2 false G1 (open (varH (length GH)) T1) G2 T2 ((0,(G1, open (varH (length GH)) T1))::GH) ->
stpd2 true G1 (TBind T1) G2 T2 GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_and11: forall G1 G2 GH T1 T2 T,
stpd2 true G1 T1 G2 T GH ->
stpd2 true G1 T2 G1 T2 GH ->
stpd2 true G1 (TAnd T1 T2) G2 T GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_and12: forall G1 G2 GH T1 T2 T,
stpd2 true G1 T2 G2 T GH ->
stpd2 true G1 T1 G1 T1 GH ->
stpd2 true G1 (TAnd T1 T2) G2 T GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_and2: forall G1 G2 GH T1 T2 T,
stpd2 false G1 T G2 T1 GH ->
stpd2 false G1 T G2 T2 GH ->
stpd2 true G1 T G2 (TAnd T1 T2) GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_or21: forall G1 G2 GH T1 T2 T,
stpd2 false G1 T G2 T1 GH ->
stpd2 true G2 T2 G2 T2 GH ->
stpd2 true G1 T G2 (TOr T1 T2) GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_or22: forall G1 G2 GH T1 T2 T,
stpd2 false G1 T G2 T2 GH ->
stpd2 true G2 T1 G2 T1 GH ->
stpd2 true G1 T G2 (TOr T1 T2) GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_or1: forall G1 G2 GH T1 T2 T,
stpd2 true G1 T1 G2 T GH ->
stpd2 true G1 T2 G2 T GH ->
stpd2 true G1 (TOr T1 T2) G2 T GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_wrapf: forall G1 G2 T1 T2 GH,
stpd2 true G1 T1 G2 T2 GH ->
stpd2 false G1 T1 G2 T2 GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma stpd2_transf: forall G1 G2 G3 T1 T2 T3 GH,
stpd2 true G1 T1 G2 T2 GH ->
stpd2 false G2 T2 G3 T3 GH ->
stpd2 false G1 T1 G3 T3 GH.
Proof. intros. repeat eu. eauto. Qed.
Lemma sstpd2_wrapf: forall G1 G2 T1 T2 GH,
sstpd2 true G1 T1 G2 T2 GH ->
sstpd2 false G1 T1 G2 T2 GH.
Proof. intros. repeat eu. eexists. eapply stp2_wrapf. eauto. Qed.
Lemma sstpd2_transf: forall G1 G2 G3 T1 T2 T3 GH,
sstpd2 true G1 T1 G2 T2 GH ->
sstpd2 false G2 T2 G3 T3 GH ->
sstpd2 false G1 T1 G3 T3 GH.
Proof. intros. repeat eu. eexists. eapply stp2_transf; eauto. Qed.
(*
None means timeout
Some None means stuck
Some (Some v)) means result v
Could use do-notation to clean up syntax.
*)
Fixpoint teval(n: nat)(env: venv)(t: tm){struct n}: option (option vl) :=
match n with
| 0 => None
| S n =>
match t with
| ttrue => Some (Some (vbool true))
| tfalse => Some (Some (vbool false))
| tvar x => Some (index x env)
| tobj f ds => Some (Some (vobj env f ds))
| tapp ef m ex =>
match teval n env ex with
| None => None
| Some None => Some None
| Some (Some vx) =>
match teval n env ef with
| None => None
| Some None => Some None
| Some (Some (vbool _)) => Some None
| Some (Some (vobj env2 f ds)) =>
match index m ds with
| None => Some None
| Some (dmem _) => Some None
| Some (dfun x ey) =>
teval n ((x,vx)::(f,vobj env2 f ds)::env2) ey
end
end
end
| tlet x ex ey =>
match teval n env ex with
| None => None
| Some None => Some None
| Some (Some vx) => teval n ((x,vx)::env) ey
end
end
end.
Hint Constructors ty.
Hint Constructors tm.
Hint Constructors vl.
Hint Constructors closed_rec.
Hint Constructors has_type dcs_has_type.
Hint Constructors val_type.
Hint Constructors wf_env.
Hint Constructors stp.
Hint Constructors stp2.
Hint Constructors option.
Hint Constructors list.
Hint Unfold index.
Hint Unfold length.
Hint Unfold closed.
Hint Unfold open.
Hint Resolve ex_intro.
(* ############################################################ *)
(* Examples *)
(* ############################################################ *)
(*
match goal with
| |- has_type _ (tvar _) _ =>
try solve [apply t_vara;
repeat (econstructor; eauto)]
| _ => idtac
end;
*)
Ltac crush_has_tp :=
try solve [eapply stp_selx; compute; eauto; crush_has_tp];
try solve [eapply stp_selax; compute; eauto; crush_has_tp];
try solve [eapply cl_selb; compute; eauto; crush_has_tp];
try solve [(econstructor; compute; eauto; crush_has_tp)].
Ltac crush2 :=
try solve [(eapply stp_selx; compute; eauto; crush2)];
try solve [(eapply stp_selax; compute; eauto; crush2)];
try solve [(eapply stp_sel1; compute; eauto; crush2)];
try solve [(eapply stp_sela1; compute; eauto; crush2)];
try solve [(eapply cl_selb; compute; eauto; crush2)];
try solve [(eapply stp_and2; [eapply stp_and11; crush2 | eapply stp_and12; crush2])];
try solve [(econstructor; compute; eauto; crush2)];
try solve [(eapply t_sub; eapply t_var; compute; eauto; crush2)].
Ltac crush_cl :=
try solve [(econstructor; compute; eauto; crush_cl)].
Ltac crush_wf :=
try solve [(eapply stp_topx; crush_wf)];
try solve [(eapply stp_botx; crush_wf)];
try solve [(eapply stp_bool; crush_wf)];
try solve [(eapply stp_selx; compute; eauto; crush_wf)];
try solve [(eapply stp_selax; compute; eauto; crush_wf)];
try solve [(eapply stp_mem; crush_wf)];
try solve [(eapply stp_all; [crush_wf | (compute; eauto) | crush_cl | crush_cl | crush_wf | crush_wf])];
try solve [(eapply stp_bindx; [(compute; eauto) | crush_cl | crush_cl | crush_wf | crush_wf])];
try solve [(eapply stp_and2; [eapply stp_and11; crush_wf | eapply stp_and12; crush_wf])].
(* define polymorphic identity function *)
Definition polyId := TAll 0 (TMem 0 TBot TTop) (TAll 0 (TSel (varB 0) 0) (TSel (varB 1) 0)).
Example ex1: has_type [] (tobj 0 [(0, dfun 1 (tobj 2 [(0, (dfun 3 (tvar 3)))]))]) polyId.
Proof.
eapply t_sub with (T1:=TBind polyId).
apply t_obj with (TX:=polyId). eauto. compute. reflexivity.
{
eapply dt_fun with (T1:=(TMem 0 TBot TTop)) (T2:=TAll 0 (TSel (varB 0) 0) (TSel (varB 1) 0)).
unfold open. simpl.
eapply t_sub with (T1:=(TBind (TAll 0 (TSel (varF 1) 0) (TSel (varF 1) 0)))).
eapply t_obj with (TX:=(TAll 0 (TSel (varF 1) 0) (TSel (varF 1) 0))). eauto. compute. reflexivity.
{ eapply dt_fun with (T1:=(TSel (varF 1) 0)) (T2:=(TSel (varF 1) 0)). eapply t_var. compute. reflexivity.
crush2. crush2. crush2. crush2. simpl. eauto. }
crush_wf. crush_wf. { eapply stp_bind1. eauto. crush2. crush2. crush_wf. compute. crush_wf. }
eauto. eauto. eauto. simpl. eauto. }
crush_wf. crush_wf.
eapply stp_bind1. eauto. crush2. crush2. crush_wf. crush_wf.
Qed.
(* instantiate it to bool *)
Example ex2: has_type [(0,polyId)] (tapp (tvar 0) 0 (tobj 1 [(0,dmem TBool)])) (TAll 0 TBool TBool).
Proof.
eapply t_app. instantiate (1:= (TMem 0 TBool TBool)).
{ eapply t_sub.
{ eapply t_var. simpl. eauto. crush2. }
{ eapply stp_all; eauto. compute. eapply cl_all; eauto. crush_wf. crush2. }
}
{ eapply t_sub. eapply t_obj. eauto. eauto. eauto. crush_wf. crush_wf. eapply stp_bind1; eauto. crush2. crush2. }
crush_wf.
Qed.
(* define brand / unbrand client function *)
(* TODO: get rid of bind/let *)
Definition brandUnbrand :=
TAll 0
(TBind (TMem 0 TBot TTop))
(TBind (TAll 0
(TBind (TAnd
(TAll 1 TBool (TSel (varB 3) 0)) (* brand *)
(TAll 0 (TSel (varB 2) 0) TBool) (* unbrand *)
)
)
TBool)).
Example ex3:
has_type []
(tlet 0
(tobj 0 [(0, dfun 1
(tobj 2 [(0, dfun 3
(tapp (tvar 3) 0 (tapp (tvar 3) 1 ttrue)))]))])
(tvar 0))
brandUnbrand.
Proof.
apply t_let with (Tx:=(TBind brandUnbrand)).
apply t_obj with (TX:=brandUnbrand).
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TBind (TMem 0 TBot TTop))
(T2:= (TBind (TAll 0
(TBind (TAnd
(TAll 1 TBool (TSel (varB 3) 0)) (* brand *)
(TAll 0 (TSel (varB 2) 0) TBool) (* unbrand *)
)
)
TBool))).
unfold open. simpl. eapply t_obj.
simpl. reflexivity.
unfold open. simpl. reflexivity.
eapply dt_fun.
instantiate (2:=(TBind (TAnd (TAll 1 TBool (TSel (varF 1) 0)) (TAll 0 (TSel (varF 1) 0) TBool)))). instantiate (1:=TBool).
eapply t_app.
instantiate (1:=(TSel (varF 1) 0)).
assert (open (varF 3) (TAll 0 (TSel (varF 1) 0) TBool)=TAll 0 (TSel (varF 1) 0) TBool) as A. { compute. reflexivity. }
unfold open. simpl.
rewrite <- A. eapply t_var_unpack.
eapply t_sub. eapply t_var. compute. reflexivity.
crush2.
eapply stp_bindx. simpl. reflexivity. crush2. crush2.
unfold open. simpl.
crush_wf.
unfold open. simpl.
eapply stp_and12; crush2.
unfold open. simpl. crush2.
eapply t_app.
instantiate (1:=TBool).
assert (open (varF 3) (TAll 1 TBool (TSel (varF 1) 0))=TAll 1 TBool (TSel (varF 1) 0) ) as A. { compute. reflexivity. }
rewrite <- A. eapply t_var_unpack.
eapply t_sub. eapply t_var. compute. reflexivity.
crush_wf. crush2. crush_wf. crush2. crush_wf. crush_wf. crush2. crush2. crush2. crush2.
crush2. crush_wf. crush2. crush2. crush2. crush2. crush_wf. crush_wf. crush2.
assert (open (varF 0) brandUnbrand=brandUnbrand) as A. { compute. reflexivity. }
rewrite <- A at 2.
eapply t_var_unpack. eapply t_var. simpl. reflexivity.
crush_wf. crush_wf. crush_wf.
Qed.
Example ex4:
has_type [(1,TAll 0 TBool TBool);(0,brandUnbrand)]
(tvar 0) (TAll 0 (TBind (TMem 0 TBool TBool)) (TBind (TAll 0 (TBind (TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool))) TBool))).
Proof.
eapply t_sub.
eapply t_var. compute. reflexivity.
crush_wf.
eapply stp_all. crush2. crush2. crush2. crush2. crush_wf.
eapply stp_bindx. crush2. crush2. crush2. crush_wf.
unfold open. simpl.
eapply stp_all. eapply stp_bindx. crush2. crush2. crush2.
unfold open. simpl. crush_wf.
unfold open. simpl.
eapply stp_and2.
eapply stp_and11; crush2. eapply stp_and12; crush2. (* eapply stp_all; crush2. *)
unfold open. simpl. eauto. eauto. eauto. eauto. eauto.
Qed.
Hint Resolve ex4.
(* apply it to identity functions *)
Example ex5:
has_type [(1,TAll 0 TBool TBool);(0,brandUnbrand)]
(tapp (tlet 2 (tapp (tvar 0) 0 (tobj 2 [(0,dmem TBool)])) (tvar 2)) 0 (tobj 2 [(1, dfun 3 (tapp (tvar 1) 0 (tvar 3))); (0, dfun 3 (tapp (tvar 1) 0 (tvar 3)))])) TBool.
Proof.
eapply t_app.
eapply t_let.
eapply t_app.
instantiate (2:=TBind (TMem 0 TBool TBool)).
instantiate (1:=(TBind (TAll 0
(TBind (TAnd
(TAll 1 TBool TBool) (* brand *)
(TAll 0 TBool TBool) (* unbrand *)
)
)
TBool))).
eapply t_sub.
eapply t_var. compute. reflexivity.
crush_wf.
eapply stp_all.
crush2.
simpl. reflexivity.
crush2. crush2. crush_wf.
unfold open. simpl.
eapply stp_bindx. simpl. eauto. crush2. crush2. crush_wf.
unfold open. simpl.
eapply stp_all. eapply stp_bindx. simpl. eauto. crush2. crush2.
unfold open. simpl.
crush_wf.
unfold open. simpl.
eapply stp_and2. eapply stp_and11; crush2. (*
eapply stp_all.
crush_wf. crush2. crush2. crush2. crush_wf.
eapply stp_selab2. compute. reflexivity. crush2.
instantiate (1:=TBool). crush2.
instantiate (1:=[(0, TBind (TMem 0 TBool TBool))]). crush2.
instantiate (1:=[(0, TBool); (0, TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool));
(0,
TAll 0
(TBind
(TAnd (TAll 1 TBool (TSel (varH 0) 0))
(TAll 0 (TSel (varH 0) 0) TBool))) TBool)]). crush2.
crush2. crush2. crush2.*)
eapply stp_and12; crush2. (*
eapply stp_all. crush2. eapply stp_selab1. compute. reflexivity. crush2.
instantiate (1:=TBool). crush2.
instantiate (1:=[(0, TBind (TMem 0 TBool TBool))]). crush2.
instantiate (1:=[(0, TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool));
(0,
TAll 0
(TBind
(TAnd (TAll 1 TBool (TSel (varH 0) 0))
(TAll 0 (TSel (varH 0) 0) TBool))) TBool)]). crush2.
crush2. crush2. crush_wf. *)
crush2. crush2.
crush2. crush_wf. crush_wf. crush2. crush2. crush2. crush_wf. crush_wf.
crush2.
crush_wf. crush2.
instantiate (1:=(TBind (TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool)))).
assert (open (varF 2) (TAll 0 (TBind (TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool))) TBool) = (TAll 0 (TBind (TAnd (TAll 1 TBool TBool) (TAll 0 TBool TBool))) TBool)) as A. {
compute. reflexivity.
}
rewrite <- A. eapply t_var_unpack. eapply t_var. compute. reflexivity.
crush_wf. crush_wf. crush_wf.
eapply t_obj. eauto. unfold open. simpl. reflexivity.
eapply dt_fun.
instantiate (1:=TBool). unfold open. simpl.
eapply t_app. eapply t_var. compute. reflexivity.
crush_wf.
instantiate (1:=TBool). unfold open. simpl. crush2. crush_wf.
instantiate (1:=TAll 0 TBool TBool).
eapply dt_fun.
instantiate (1:=TBool). unfold open. simpl.
eapply t_app. eapply t_var. compute. reflexivity.
crush_wf.
instantiate (1:=TBool). unfold open. simpl. crush2. crush_wf.
eapply dt_nil.
eauto. eauto. simpl. reflexivity. eauto. eauto. eauto.
crush_wf. crush_wf. crush_wf.
Qed.
(* test expansion *)
Example ex6:
has_type [(1,TSel (varF 0) 0);(0,TMem 0 TBot (TBind (TAll 0 TBool (TSel (varB 1) 0))))]
(tvar 1) (TAll 0 TBool (TSel (varF 1) 0)).
Proof.
remember (TAll 0 TBool (TSel (varF 1) 0)) as T.
assert (T = open (varF 1) (TAll 0 TBool (TSel (varB 1) 0))). compute. eauto.
rewrite H.
eapply t_var_unpack. eapply t_sub. eapply t_var. compute. eauto. crush_wf. crush2. crush_wf.
Qed.
Example ex7:
stp [(1,TSel (varF 0) 0);(0,TMem 0 TBot (TBind (TMem 0 TBot (TAll 0 TBool (TSel (varB 1) 0)))))] []
(TSel (varF 1) 0) (TAll 0 TBool (TSel (varF 1) 0)).
Proof.
remember (TAll 0 TBool (TSel (varF 1) 0)) as T.
assert (T = open (varF 1) (TAll 0 TBool (TSel (varB 1) 0))). compute. eauto.
rewrite H.
eapply stp_selb1. compute. eauto.
eapply stp_sel1. compute. eauto.
crush2.
eapply stp_mem. eauto.
eapply stp_bindx; crush2.
eapply stp_bindx; crush2.
crush2.
Qed.
(*
val listModule = new { m =>
type List = { this =>
type Elem
def head(): this.Elem
def tail(): m.List & { type Elem <: this.Elem }
}
def nil() = new { this =>
type Elem = Bot
def head() = bot()
def tail() = bot()
}
def cons[T](hd: T)(tl: m.List & { type Elem <: T }) = new { this =>
type Elem = T
def head() = hd
def tail() = tl
}
}
type ListAPI = { m =>
type List <: { this =>
type Elem
def head(): this.Elem
def tail(): m.List & { type Elem <: this.Elem }
}
def nil(): List & { type Elem = Bot }
def cons[T]: T =>
m.List & { type Elem <: T } =>
m.List & { type Elem <: T }
}
def cons(t: { type T }) = new {
def apply(hd: t.T) = new {
def apply(m.List & { type Elem <: t.T }) = new { this =>
type Elem = t.T
def head() = hd
def tail() = tl
}}}
*)
Example paper_list_nil_head:
has_type
[]
(tobj 0
[(1, dfun 1 (tlet 2 (tobj 2 [(1, dfun 3 (tapp (tvar 2) 1 (tvar 3)));
(0, dmem TBot)])
(tvar 2)));
(0, dmem (TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))
])
(TBind (TAnd
(TAll 1 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TMem 0
TBot
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))).
Proof.
apply t_sub with (T1:=(TBind (TAnd
(TAll 1 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TMem 0
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot)))).
apply t_let with (Tx:=(TBind (TAnd (TAll 1 TTop TBot) (TMem 0 TBot TBot)))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=TBot).
simpl. unfold open at 3. simpl. eapply t_app.
eapply t_sub. eapply t_var. compute. reflexivity. crush_wf.
apply stp_and11. crush_wf. crush_wf. crush2. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. crush_wf. crush_wf. eauto.
simpl. unfold open at 2. simpl.
eapply t_sub. eapply t_var. compute. eauto. crush_wf.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush2.
eapply stp_and12. crush2. crush_wf. crush_wf.
eapply stp_bindx. eauto. crush2. crush2. crush_wf.
unfold open. simpl. eapply stp_and12. crush_wf. crush_wf.
unfold open. simpl. crush_wf.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. crush_wf. crush_wf.
crush2.
Qed.
Example paper_list_nil:
has_type
[]
(tobj 0
[(1, dfun 1 (tlet 2 (tobj 2 [(2, dfun 3 (tapp (tvar 2) 2 (tvar 3)));
(1, dfun 3 (tapp (tvar 2) 1 (tvar 3)));
(0, dmem TBot)])
(tvar 2)));
(0, dmem (TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))
])
(TBind (TAnd
(TAll 1 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TMem 0
TBot
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))))).
Proof.
apply t_sub with (T1:=(TBind (TAnd
(TAll 1 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TMem 0
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot)))).
apply t_let with (Tx:=(TBind (TAnd (TAll 2 TTop TBot) (TAnd (TAll 1 TTop TBot) (TMem 0 TBot TBot))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=TBot).
simpl. unfold open at 3. simpl. eapply t_app.
eapply t_sub. eapply t_var. compute. reflexivity. crush_wf.
apply stp_and11. crush_wf. crush_wf. crush2. crush2.
eapply dt_fun with (T1:=TTop) (T2:=TBot).
simpl. unfold open at 3. simpl. eapply t_app.
eapply t_sub. eapply t_var. compute. reflexivity. crush_wf.
apply stp_and12. apply stp_and11. crush_wf. crush_wf. crush2. crush2. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. eauto. eauto. simpl. reflexivity.
crush_wf. crush_wf. eauto.
simpl. unfold open at 2. simpl.
eapply t_sub. eapply t_var. compute. eauto. crush_wf.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush2.
eapply stp_and12.
eapply stp_mem. eapply stp_bindx. eauto. crush_cl. crush_cl.
unfold open. simpl. crush_wf. unfold open. simpl.
apply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto. crush_cl. crush_cl.
unfold open. simpl. crush_wf. unfold open. simpl. eapply stp_bot. crush_wf. crush_wf.
eapply stp_and12. eapply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto.
crush_cl. crush_cl. unfold open. simpl. crush_wf. unfold open. simpl. eapply stp_bot.
crush_wf. crush_wf. eapply stp_and12. eapply stp_mem. crush_wf. crush2. crush_wf.
crush_wf. eapply stp_top. crush_wf. crush_wf. crush_wf.
eapply stp_bindx. eauto. crush2. crush2. crush_wf.
unfold open. simpl. eapply stp_and12. eapply stp_and12. crush_wf. crush_wf. crush_wf.
unfold open. simpl. crush_wf.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. crush_wf. crush_wf.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf. unfold open. simpl.
eapply stp_and2. eapply stp_and11. crush_wf. crush_wf. eapply stp_and12.
eapply stp_mem. eapply stp_bot. crush_wf. crush_wf. crush_wf.
Qed.
Example paper_list_cons_head:
has_type
[]
(tobj 0
[(1, dfun 1(*type T*) (tlet 2 (tobj 2
[(0, dfun 3(*hd*) (tlet 4 (tobj 4 [(0, dfun 5(*tl*) (tlet 6 (tobj 6
[(1, dfun 7 (tvar 3));
(0, dmem (TSel (varF 1) 0))]) (tvar 6)))]) (tvar 4)))]) (tvar 2)));
(0, dmem (TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))
])
(TBind (TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
TBot
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))).
Proof.
apply t_sub with (T1:=
(TBind (TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))
(TBind (TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TMem 0 TBot TTop))
(T2:=(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0))))))).
apply t_let with (Tx:=(TBind
(TAll 0 (TSel (varF 1) 0)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TSel (varF 1) 0))
(T2:=(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))).
apply t_let with (Tx:=(TBind (TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(T2:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))).
apply t_let with (Tx:=(TBind (TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TSel (varF 1) 0)).
simpl. unfold open. simpl. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. crush_wf. crush_wf. eauto.
simpl. unfold open. simpl.
eapply t_sub.
eapply t_var. compute. eauto. crush_wf.
compute.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush2.
eapply stp_and12. eapply stp_mem. eapply stp_bindx.
eauto. crush2. crush2.
unfold open. simpl. crush_wf.
unfold open. simpl.
eapply stp_and2. eapply stp_and11.
eapply stp_all. crush_wf. eauto. crush2. crush2.
unfold open. simpl. crush_wf. unfold open. simpl.
eapply stp_sela2. compute. reflexivity. (*compute. eauto.
instantiate (1:=[(0, TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0)))]). eauto.
instantiate (1:=[(0, TTop)]). eauto. *)
eapply stp_and12. crush2. crush2. crush2. crush_wf.
eapply stp_and12. crush2. crush_wf. crush2. crush_wf. crush_wf.
eapply stp_bindx. eauto. crush2. crush2. crush_wf.
unfold open. simpl. eapply stp_and12. crush2. crush_wf. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf.
eauto.
unfold open. simpl.
assert (open (varF 4)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))) =
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) as A. {
compute. reflexivity.
}
rewrite <- A at 3. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
crush_wf. unfold open. simpl. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf. crush2.
unfold open. simpl.
assert (open (varF 2) (TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) =
(TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))) as B. {
compute. reflexivity.
}
rewrite <- B at 2. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
unfold open. simpl. crush_wf. unfold open. simpl. crush_wf.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto. simpl. reflexivity.
crush_wf. crush_wf.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf.
unfold open. simpl. eapply stp_and2.
eapply stp_and11; crush_wf.
eapply stp_and12. eapply stp_mem. eapply stp_bot. crush_wf. crush_wf. crush_wf.
Qed.
Example paper_list_cons:
has_type
[]
(tobj 0
[(1, dfun 1(*type T*) (tlet 2 (tobj 2
[(0, dfun 3(*hd*) (tlet 4 (tobj 4 [(0, dfun 5(*tl*) (tlet 6 (tobj 6
[(2, dfun 7 (tvar 5)); (1, dfun 7 (tvar 3));
(0, dmem (TSel (varF 1) 0))]) (tvar 6)))]) (tvar 4)))]) (tvar 2)));
(0, dmem (TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))
])
(TBind (TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
TBot
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))))).
Proof.
apply t_sub with (T1:=
(TBind (TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TMem 0 TBot TTop))
(T2:=(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0))))))).
apply t_let with (Tx:=(TBind
(TAll 0 (TSel (varF 1) 0)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TSel (varF 1) 0))
(T2:=(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))).
apply t_let with (Tx:=(TBind (TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(T2:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))).
apply t_let with (Tx:=(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0)))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))).
simpl. unfold open. simpl. crush2.
eapply dt_fun with (T1:=TTop) (T2:=(TSel (varF 1) 0)).
simpl. unfold open. simpl. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf. eauto.
simpl. unfold open. simpl.
eapply t_sub.
eapply t_var. compute. eauto. crush_wf.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush_cl.
eapply stp_and12. eapply stp_mem. eapply stp_bindx.
eauto. crush2. crush2.
unfold open. simpl. crush_wf.
unfold open. simpl.
eapply stp_and2. eapply stp_and11.
eapply stp_all. crush_wf. eauto. crush2. crush2.
unfold open. simpl. crush_wf. unfold open. simpl.
eapply stp_and2. eapply stp_and11. crush_wf. crush_wf. eapply stp_and12.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf. unfold open. simpl.
eapply stp_mem. crush_wf. unfold open. simpl.
eapply stp_sela2. compute. reflexivity. (*crush_cl.
instantiate (1:=[(0, TAnd (TAll 2 TTop (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))) (TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0))))]). eauto.
instantiate (1:=[(0, TMem 0 TBot (TSel (varF 1) 0)); (0, TTop)]). eauto. *)
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf. crush_wf.
crush_wf.
eapply stp_and12. eapply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto.
crush_cl. crush_cl. unfold open. simpl. crush_wf. unfold open. simpl.
eapply stp_sela2. compute. reflexivity. (*crush_cl.
instantiate (1:=[(0, TAnd (TAll 2 TTop (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))) (TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0))))]). eauto.
instantiate (1:=[(0, TTop)]). eauto.*)
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf. crush_wf.
eapply stp_and12. crush2. crush_wf. crush_wf. eapply stp_top. crush_wf. crush_wf.
crush_wf. eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf. unfold open. simpl.
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf.
eauto.
unfold open. simpl.
assert (open (varF 4)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))) =
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) as A. {
compute. reflexivity.
}
rewrite <- A at 3. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
crush_wf. unfold open. simpl. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf. crush2.
unfold open. simpl.
assert (open (varF 2) (TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) =
(TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))) as B. {
compute. reflexivity.
}
rewrite <- B at 2. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
unfold open. simpl. crush_wf. unfold open. simpl. crush_wf.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto. simpl. reflexivity.
crush_wf. crush_wf.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf.
unfold open. simpl. eapply stp_and2.
eapply stp_and11; crush_wf.
eapply stp_and12. eapply stp_mem. eapply stp_bot. crush_wf. crush_wf. crush_wf.
Qed.
Example paper_list:
has_type
[]
(tobj 0
[(2, dfun 1 (tlet 2 (tobj 2 [(2, dfun 3 (tapp (tvar 2) 2 (tvar 3)));
(1, dfun 3 (tapp (tvar 2) 1 (tvar 3)));
(0, dmem TBot)])
(tvar 2)));
(1, dfun 1(*type T*) (tlet 2 (tobj 2
[(0, dfun 3(*hd*) (tlet 4 (tobj 4 [(0, dfun 5(*tl*) (tlet 6 (tobj 6
[(2, dfun 7 (tvar 5)); (1, dfun 7 (tvar 3));
(0, dmem (TSel (varF 1) 0))]) (tvar 6)))]) (tvar 4)))]) (tvar 2)));
(0, dmem (TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))
])
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
TBot
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop)))))))).
Proof.
apply t_sub with (T1:=
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot))))
(TAnd
(TAll 1 (TMem 0 TBot TTop)
(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0)))))))
(TMem 0
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))
(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0)))))
(TAnd
(TAll 1 TTop (TSel (varB 1) 0))
(TMem 0 TBot TTop))))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TAnd (TSel (varB 1) 0) (TBind (TMem 0 TBot TBot)))).
apply t_let with (Tx:=(TBind (TAnd (TAll 2 TTop TBot) (TAnd (TAll 1 TTop TBot) (TMem 0 TBot TBot))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=TBot).
simpl. unfold open at 3. simpl. eapply t_app.
eapply t_sub. eapply t_var. compute. reflexivity. crush_wf.
apply stp_and11. crush_wf. crush_wf. crush2. crush2.
eapply dt_fun with (T1:=TTop) (T2:=TBot).
simpl. unfold open at 3. simpl. eapply t_app.
eapply t_sub. eapply t_var. compute. reflexivity. crush_wf.
apply stp_and12. apply stp_and11. crush_wf. crush_wf. crush2. crush2. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. eauto. eauto. simpl. reflexivity.
crush_wf. crush_wf. eauto.
simpl. unfold open at 2. simpl.
eapply t_sub. eapply t_var. compute. eauto. crush_wf.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush2.
eapply stp_and12. eapply stp_and12.
eapply stp_mem. eapply stp_bindx. eauto. crush_cl. crush_cl.
unfold open. simpl. crush_wf. unfold open. simpl.
apply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto. crush_cl. crush_cl.
unfold open. simpl. crush_wf. unfold open. simpl. eapply stp_bot. crush_wf. crush_wf.
eapply stp_and12. eapply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto.
crush_cl. crush_cl. unfold open. simpl. crush_wf. unfold open. simpl. eapply stp_bot.
crush_wf. crush_wf. eapply stp_and12. eapply stp_mem. crush_wf. crush2. crush_wf.
crush_wf. eapply stp_top. crush_wf. crush_wf. crush_wf.
crush_wf.
eapply stp_bindx. eauto. crush2. crush2. crush_wf.
unfold open. simpl. eapply stp_and12. eapply stp_and12. crush_wf. crush_wf. crush_wf.
unfold open. simpl. crush_wf.
eapply dt_fun with (T1:=(TMem 0 TBot TTop))
(T2:=(TAll 0 (TSel (varB 0) 0)
(TAll 0 (TAnd (TSel (varB 2) 0) (TBind (TMem 0 TBot (TSel (varB 2) 0))))
(TAnd (TSel (varB 3) 0) (TBind (TMem 0 TBot (TSel (varB 3) 0))))))).
apply t_let with (Tx:=(TBind
(TAll 0 (TSel (varF 1) 0)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TSel (varF 1) 0))
(T2:=(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))).
apply t_let with (Tx:=(TBind (TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(T2:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))).
apply t_let with (Tx:=(TBind (TAnd
(TAll 2 TTop (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(TAnd (TAll 1 TTop (TSel (varF 1) 0)) (TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0)))))).
eapply t_obj.
eauto. compute. reflexivity.
eapply dt_fun with (T1:=TTop) (T2:=(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))).
simpl. unfold open. simpl. crush2.
eapply dt_fun with (T1:=TTop) (T2:=(TSel (varF 1) 0)).
simpl. unfold open. simpl. crush2.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto.
simpl. reflexivity. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf. eauto.
simpl. unfold open. simpl.
eapply t_sub.
eapply t_var. compute. eauto. crush_wf.
eapply stp_and2. eapply stp_sel2. compute. reflexivity. crush_cl.
eapply stp_and12. eapply stp_and12. eapply stp_mem. eapply stp_bindx.
eauto. crush2. crush2.
unfold open. simpl. crush_wf.
unfold open. simpl.
eapply stp_and2. eapply stp_and11.
eapply stp_all. crush_wf. eauto. crush2. crush2.
unfold open. simpl. crush_wf. unfold open. simpl.
eapply stp_and2. eapply stp_and11. crush_wf. crush_wf. eapply stp_and12.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf. unfold open. simpl.
eapply stp_mem. crush_wf. unfold open. simpl.
eapply stp_sela2. compute. reflexivity. (*crush_cl.
instantiate (1:=[(0,
TAnd
(TAll 2 TTop
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(TAnd (TAll 1 TTop (TSel (varF 1) 0))
(TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0))))]). eauto.
instantiate (1:=[(0, TMem 0 TBot (TSel (varF 1) 0)); (0, TTop)]). eauto.*)
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf. crush_wf.
crush_wf.
eapply stp_and12. eapply stp_and2. eapply stp_and11. eapply stp_all. crush_wf. eauto.
crush_cl. crush_cl. unfold open. simpl. crush_wf. unfold open. simpl.
eapply stp_sela2. compute. reflexivity. (*crush_cl.
instantiate (1:=[(0,
TAnd
(TAll 2 TTop
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))
(TAnd (TAll 1 TTop (TSel (varF 1) 0))
(TMem 0 (TSel (varF 1) 0) (TSel (varF 1) 0))))]). eauto.
instantiate (1:=[(0, TTop)]). eauto.*)
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf. crush_wf.
eapply stp_and12. crush2. crush_wf. crush_wf. eapply stp_top. crush_wf. crush_wf.
crush_wf. eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf. unfold open. simpl.
crush_wf. eapply stp_bindx. eauto. crush_cl. crush_cl. unfold open. simpl. crush_wf.
unfold open. simpl.
eapply stp_and12. eapply stp_and12. crush2. crush_wf. crush_wf. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf.
eauto.
unfold open. simpl.
assert (open (varF 4)
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))) =
(TAll 0 (TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) as A. {
compute. reflexivity.
}
rewrite <- A at 3. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
crush_wf. unfold open. simpl. crush_wf.
eapply dt_nil. eauto. eauto. simpl. reflexivity. crush_wf. crush_wf. crush2.
unfold open. simpl.
assert (open (varF 2) (TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0)))))) =
(TAll 0 (TSel (varF 1) 0)
(TAll 0
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))
(TAnd (TSel (varF 0) 0) (TBind (TMem 0 TBot (TSel (varF 1) 0))))))) as B. {
compute. reflexivity.
}
rewrite <- B at 2. apply t_var_unpack. apply t_var. compute. reflexivity. crush_wf.
unfold open. simpl. crush_wf. unfold open. simpl. crush_wf.
eapply dt_mem. eapply dt_nil. eauto. simpl. reflexivity. eauto. eauto. simpl. reflexivity.
eauto. eauto. simpl. reflexivity.
crush_wf. crush_wf.
eapply stp_bindx. eauto. crush_cl. crush_cl. crush_wf.
unfold open. simpl. eapply stp_and2.
eapply stp_and11; crush_wf.
eapply stp_and12. eapply stp_and2.
eapply stp_and11; crush_wf. eapply stp_and12.
eapply stp_mem. eapply stp_bot. crush_wf. crush_wf. crush_wf.
crush_wf.
Qed.
(* ############################################################ *)
(* Proofs *)
(* ############################################################ *)
Ltac ev := repeat match goal with
| H: exists _, _ |- _ => destruct H
| H: _ /\ _ |- _ => destruct H
end.
Lemma wf_fresh : forall vs ts,
wf_env vs ts ->
(fresh vs = fresh ts).
Proof.
intros. induction H. auto.
compute. eauto.
Qed.
Hint Immediate wf_fresh.
Lemma wfh_length : forall vvs vs ts,
wf_envh vvs vs ts ->
(length vs = length ts).
Proof.
intros. induction H. auto.
compute. eauto.
Qed.
Hint Immediate wf_fresh.
Lemma index_max : forall X vs n (T: X),
index n vs = Some T ->
n < fresh vs.
Proof.
intros X vs. induction vs.
- Case "nil". intros. inversion H.
- Case "cons".
intros. inversion H. destruct a.
case_eq (le_lt_dec (fresh vs) i); intros ? E1.
+ SCase "ok".
rewrite E1 in H1.
case_eq (beq_nat n i); intros E2.
* SSCase "hit".
eapply beq_nat_true in E2. subst n. compute. eauto.
* SSCase "miss".
rewrite E2 in H1.
assert (n < fresh vs). eapply IHvs. apply H1.
compute. omega.
+ SCase "bad".
rewrite E1 in H1. inversion H1.
Qed.
Lemma indexr_max : forall X vs n (T: X),
indexr n vs = Some T ->
n < length vs.
Proof.
intros X vs. induction vs.
- Case "nil". intros. inversion H.
- Case "cons".
intros. inversion H. destruct a.
case_eq (beq_nat n (length vs)); intros E2.
+ SSCase "hit".
eapply beq_nat_true in E2. subst n. compute. eauto.
+ SSCase "miss".
rewrite E2 in H1.
assert (n < length vs). eapply IHvs. apply H1.
compute. eauto.
Qed.
Lemma tailr_max : forall X vs n (T: X) GL,
tailr (S n) vs = (0,T)::GL ->
n < length vs.
Proof.
intros X vs. induction vs.
- Case "nil". intros. inversion H.
- Case "cons".
intros. inversion H. destruct a.
case_eq (beq_nat n (length vs)); intros E2.
+ SSCase "hit".
eapply beq_nat_true in E2. subst n. compute. eauto.
+ SSCase "miss".
rewrite E2 in H1.
assert (n < length vs). eapply IHvs. apply H1.
compute. eauto.
Qed.
Lemma tailr_to_indexr: forall GH GL x (TX:ty),
tailr (S x) GH = (0,TX)::GL ->
indexr x GH = Some TX /\ length GL = x /\ exists GU, GH = GU ++ ((0,TX)::GL).
Proof.
intros GH. induction GH.
- intros. inversion H.
- intros. case_eq (beq_nat x (length GH)); intros E.
+ (* hit *) inversion H. destruct a. rewrite E in H1. inversion H1. subst.
repeat split; eauto. simpl. rewrite E. eauto. symmetry. eapply beq_nat_true_iff. eauto.
rewrite E. eexists. rewrite app_nil_l. eauto.
+ (* miss *) inversion H. destruct a. rewrite E in H1.
repeat split; eauto. simpl. rewrite E. eauto. eapply IHGH. eauto. eapply IHGH. eauto.
rewrite E. edestruct IHGH. eauto. ev. eexists. rewrite H1. instantiate (1:= (i,t)::x0). simpl. rewrite <-H3. eauto.
Qed.
Lemma le_xx : forall a b,
a <= b ->
exists E, le_lt_dec a b = left E.
Proof. intros.
case_eq (le_lt_dec a b). intros. eauto.
intros. omega.
Qed.
Lemma le_yy : forall a b,
a > b ->
exists E, le_lt_dec a b = right E.
Proof. intros.
case_eq (le_lt_dec a b). intros. omega.
intros. eauto.
Qed.
Lemma index_extend : forall X vs n n' x (T: X),
index n vs = Some T ->
fresh vs <= n' ->
index n ((n',x)::vs) = Some T.
Proof.
intros.
assert (n < fresh vs). eapply index_max. eauto.
assert (n <> n'). omega.
assert (beq_nat n n' = false) as E. eapply beq_nat_false_iff; eauto.
assert (fresh vs <= n') as E2. omega.
elim (le_xx (fresh vs) n' E2). intros ? EX.
unfold index. unfold index in H. rewrite H. rewrite E. rewrite EX. reflexivity.
Qed.
Lemma indexr_extend : forall X vs n n' x (T: X),
indexr n vs = Some T ->
indexr n ((n',x)::vs) = Some T.
Proof.
intros.
assert (n < length vs). eapply indexr_max. eauto.
assert (beq_nat n (length vs) = false) as E. eapply beq_nat_false_iff. omega.
unfold indexr. unfold indexr in H. rewrite H. rewrite E. reflexivity.
Qed.
(* splicing -- for stp_extend. not finished *)
Fixpoint splice n (T : ty) {struct T} : ty :=
match T with
| TTop => TTop
| TBot => TBot
| TBool => TBool
| TMem m T1 T2 => TMem m (splice n T1) (splice n T2)
| TSel (varB i) m => TSel (varB i) m
| TSel (varF i) m => TSel (varF i) m
| TSel (varH i) m => TSel (varH (if le_lt_dec n i then (i+1) else i)) m
| TAll m T1 T2 => TAll m (splice n T1) (splice n T2)
| TBind T2 => TBind (splice n T2)
| TAnd T1 T2 => TAnd (splice n T1) (splice n T2)
| TOr T1 T2 => TOr (splice n T1) (splice n T2)
end.
Definition splicett n (V: (id*ty)) :=
match V with
| (x,T) => (x,(splice n T))
end.
Definition spliceat n (V: (id*(venv*ty))) :=
match V with
| (x,(G,T)) => (x,(G,splice n T))
end.
Lemma splice_open_permute: forall {X} (G:list (id*X)) T n j k,
n + k >= length G ->
(open_rec j (varH (n + S k)) (splice (length G) T)) =
(splice (length G) (open_rec j (varH (n + k)) T)).
Proof.
intros X G T. induction T; intros; simpl; eauto;
try rewrite IHT1; try rewrite IHT2; try rewrite IHT; eauto.
destruct v; try solve [compute; reflexivity]. simpl.
case_eq (beq_nat j i0); intros E; simpl; eauto.
case_eq (le_lt_dec (length G) (n+k)); intros E2 LE; simpl; eauto.
assert (n + S k=n + k + 1) as R by omega. rewrite R. reflexivity.
omega.
Qed.
Lemma indexr_splice_hi: forall G0 G2 x0 x v1 T,
indexr x0 (G2 ++ G0) = Some T ->
length G0 <= x0 ->
indexr (x0 + 1) (map (splicett (length G0)) G2 ++ (x, v1) :: G0) = Some (splice (length G0) T).
Proof.
intros G0 G2. induction G2; intros.
- eapply indexr_max in H. simpl in H. omega.
- simpl in H. destruct a.
case_eq (beq_nat x0 (length (G2 ++ G0))); intros E.
+ rewrite E in H. inversion H. subst. simpl.
rewrite app_length in E.
rewrite app_length. rewrite map_length. simpl.
assert (beq_nat (x0 + 1) (length G2 + S (length G0)) = true). eapply beq_nat_true_iff. eapply beq_nat_true_iff in E. omega.
rewrite H1. eauto.
+ rewrite E in H. eapply IHG2 in H. eapply indexr_extend. eapply H. eauto.
Qed.
Lemma indexr_spliceat_hi: forall G0 G2 x0 x v1 G T,
indexr x0 (G2 ++ G0) = Some (G, T) ->
length G0 <= x0 ->
indexr (x0 + 1) (map (spliceat (length G0)) G2 ++ (x, v1) :: G0) = Some (G, splice (length G0) T).
Proof.
intros G0 G2. induction G2; intros.
- eapply indexr_max in H. simpl in H. omega.
- simpl in H. destruct a.
case_eq (beq_nat x0 (length (G2 ++ G0))); intros E.
+ rewrite E in H. inversion H. subst. simpl.
rewrite app_length in E.
rewrite app_length. rewrite map_length. simpl.
assert (beq_nat (x0 + 1) (length G2 + S (length G0)) = true). eapply beq_nat_true_iff. eapply beq_nat_true_iff in E. omega.
rewrite H1. eauto.
+ rewrite E in H. eapply IHG2 in H. destruct p. eapply indexr_extend. eapply H. eauto.
Qed.
Lemma plus_lt_contra: forall a b,
a + b < b -> False.
Proof.
intros a b H. induction a.
- simpl in H. apply lt_irrefl in H. assumption.
- simpl in H. apply IHa. omega.
Qed.
Lemma indexr_splice_lo0: forall {X} G0 G2 x0 (T:X),
indexr x0 (G2 ++ G0) = Some T ->
x0 < length G0 ->
indexr x0 G0 = Some T.
Proof.
intros X G0 G2. induction G2; intros.
- simpl in H. apply H.
- simpl in H. destruct a.
case_eq (beq_nat x0 (length (G2 ++ G0))); intros E.
+ eapply beq_nat_true_iff in E. subst.
rewrite app_length in H0. apply plus_lt_contra in H0. inversion H0.
+ rewrite E in H. apply IHG2. apply H. apply H0.
Qed.
Lemma indexr_extend_mult: forall {X} G0 G2 x0 (T:X),
indexr x0 G0 = Some T ->
indexr x0 (G2++G0) = Some T.
Proof.
intros X G0 G2. induction G2; intros.
- simpl. assumption.
- destruct a. simpl.
case_eq (beq_nat x0 (length (G2 ++ G0))); intros E.
+ eapply beq_nat_true_iff in E.
apply indexr_max in H. subst.
rewrite app_length in H. apply plus_lt_contra in H. inversion H.
+ apply IHG2. assumption.
Qed.
Lemma indexr_splice_lo: forall G0 G2 x0 x v1 T f,
indexr x0 (G2 ++ G0) = Some T ->
x0 < length G0 ->
indexr x0 (map (splicett f) G2 ++ (x, v1) :: G0) = Some T.
Proof.
intros.
assert (indexr x0 G0 = Some T). eapply indexr_splice_lo0; eauto.
eapply indexr_extend_mult. eapply indexr_extend. eauto.
Qed.
Lemma indexr_spliceat_lo: forall G0 G2 x0 x v1 G T f,
indexr x0 (G2 ++ G0) = Some (G, T) ->
x0 < length G0 ->
indexr x0 (map (spliceat f) G2 ++ (x, v1) :: G0) = Some (G, T).
Proof.
intros.
assert (indexr x0 G0 = Some (G, T)). eapply indexr_splice_lo0; eauto.
eapply indexr_extend_mult. eapply indexr_extend. eauto.
Qed.
Lemma fresh_splice_ctx: forall G n,
fresh G = fresh (map (splicett n) G).
Proof.
intros. induction G.
- simpl. reflexivity.
- destruct a. simpl. reflexivity.
Qed.
Lemma index_splice_ctx: forall G x T n,
index x G = Some T ->
index x (map (splicett n) G) = Some (splice n T).
Proof.
intros. induction G.
- simpl in H. inversion H.
- destruct a. simpl in H.
case_eq (le_lt_dec (fresh G) i); intros E LE; rewrite LE in H.
case_eq (beq_nat x i); intros Eq; rewrite Eq in H.
inversion H. simpl. erewrite <- (fresh_splice_ctx). rewrite LE.
rewrite Eq. reflexivity.
simpl. erewrite <- (fresh_splice_ctx). rewrite LE.
rewrite Eq. apply IHG. apply H.
inversion H.
Qed.
Lemma closed_splice: forall j l T n,
closed j l T ->
closed j (S l) (splice n T).
Proof.
intros. induction H; simpl; eauto.
case_eq (le_lt_dec n x); intros E LE.
unfold closed. apply cl_selh. omega.
unfold closed. apply cl_selh. omega.
Qed.
Lemma map_splice_length_inc: forall G0 G2 x v1,
(length (map (splicett (length G0)) G2 ++ (x, v1) :: G0)) = (S (length (G2 ++ G0))).
Proof.
intros. rewrite app_length. rewrite map_length. induction G2.
- simpl. reflexivity.
- simpl. eauto.
Qed.
Lemma map_spliceat_length_inc: forall G0 G2 x v1,
(length (map (spliceat (length G0)) G2 ++ (x, v1) :: G0)) = (S (length (G2 ++ G0))).
Proof.
intros. rewrite app_length. rewrite map_length. induction G2.
- simpl. reflexivity.
- simpl. eauto.
Qed.
Lemma closed_inc: forall j l T,
closed j l T ->
closed j (S l) T.
Proof.
intros. induction H; simpl; eauto.
unfold closed. apply cl_selh. omega.
Qed.
Lemma closed_inc_mult: forall j l l' T,
closed j l T ->
l' >= l ->
closed j l' T.
Proof.
intros j l l' T H LE. induction LE.
- assumption.
- apply closed_inc. assumption.
Qed.
Ltac sp :=
match goal with
| A : ?P, H : ?P -> _ |- _ => specialize (H A)
end.
Lemma closed_splice_idem: forall k l T n,
closed k l T ->
n >= l ->
splice n T = T.
Proof.
intros. remember H. clear Heqc.
induction H; simpl; repeat sp; repeat (match goal with
| H: splice ?N ?T = ?T |- _ => rewrite H
end); eauto.
case_eq (le_lt_dec n x); intros E LE. omega. reflexivity.
Qed.
Lemma closed_upgrade: forall i j l T,
closed_rec i l T ->
j >= i ->
closed_rec j l T.
Proof.
intros. generalize dependent j. induction H; intros; eauto.
Case "TAll". econstructor. eapply IHclosed_rec1. omega. eapply IHclosed_rec2. omega.
Case "TBind". econstructor. eapply IHclosed_rec. omega.
Case "TSelB". econstructor. omega.
Qed.
Lemma closed_upgrade_free: forall i l k T,
closed_rec i l T ->
k >= l ->
closed_rec i k T.
Proof.
intros. generalize dependent k. induction H; intros; eauto.
Case "TSelH". econstructor. omega.
Qed.
Lemma closed_sel: forall j n V l1 l2, closed j n (TSel V l1) -> closed j n (TSel V l2).
Proof.
intros. inversion H; subst; constructor; assumption.
Qed.
Lemma closed_open: forall j n V l T, closed (j+1) n T -> closed j n (TSel V l) -> closed j n (open_rec j V T).
Proof.
intros. generalize dependent j. induction T; intros; inversion H; unfold closed; try econstructor; try eapply IHT1; eauto; try eapply IHT2; eauto; try eapply IHT; eauto. eapply closed_upgrade. eauto. eauto.
- Case "TSelB". simpl.
case_eq (beq_nat j i0); intros E. eapply closed_sel. eassumption.
econstructor. eapply beq_nat_false_iff in E. omega.
- eauto.
- eapply closed_upgrade; eauto.
- eapply closed_upgrade; eauto.
Qed.
Lemma stp_closed : forall G GH T1 T2,
stp G GH T1 T2 ->
closed 0 (length GH) T1 /\ closed 0 (length GH) T2.
Proof.
intros. induction H;
try solve [repeat ev; split; eauto using indexr_max];
try solve [try inversion IHstp; split; eauto; apply cl_selh; eapply indexr_max; eassumption];
try solve [inversion IHstp1 as [IH1 IH2]; inversion IH2; split; eauto; apply cl_selh; eapply indexr_max; eassumption];
try solve [inversion IHstp1 as [IH1 IH2]; inversion IHstp2; split; eauto; eapply cl_selh ; eapply tailr_max; eassumption].
Qed.
Lemma stp_closed2 : forall G1 GH T1 T2,
stp G1 GH T1 T2 ->
closed 0 (length GH) T2.
Proof.
intros. apply (proj2 (stp_closed G1 GH T1 T2 H)).
Qed.
Lemma stp_closed1 : forall G1 GH T1 T2,
stp G1 GH T1 T2 ->
closed 0 (length GH) T1.
Proof.
intros. apply (proj1 (stp_closed G1 GH T1 T2 H)).
Qed.
Lemma stp2_closed: forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
closed 0 (length GH) T1 /\ closed 0 (length GH) T2.
intros. induction H;
try solve [repeat ev; split; eauto];
try solve [try inversion IHstp2_1; try inversion IHstp2_2; split; eauto; apply cl_selh; eapply indexr_max; eassumption];
try solve [inversion IHstp2 as [IH1 IH2]; inversion IH2; split; eauto; apply cl_selh; eapply indexr_max; eassumption];
try solve [try inversion IHstp2_1; try inversion IHstp2_2; split; eauto; apply cl_varh; eapply indexr_max; eassumption];
try solve [inversion IHstp2 as [IH1 IH2]; inversion IH2; split; eauto; apply cl_varh; eapply indexr_max; eassumption].
Qed.
Lemma stp2_closed2 : forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
closed 0 (length GH) T2.
Proof.
intros. apply (proj2 (stp2_closed G1 G2 T1 T2 GH s m n1 H)).
Qed.
Lemma stp2_closed1 : forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
closed 0 (length GH) T1.
Proof.
intros. apply (proj1 (stp2_closed G1 G2 T1 T2 GH s m n1 H)).
Qed.
Lemma valtp_closed: forall G v T n,
val_type G v T n -> closed 0 0 T.
Proof.
intros. inversion H; subst; repeat ev;
match goal with
[ H : stp2 ?s ?m ?G1 ?T1 G T [] ?n |- _ ] =>
eapply stp2_closed2 in H; simpl in H; apply H
end.
Qed.
Lemma concat_same_length: forall {X} (GU: list X) (GL: list X) (GH1: list X) (GH0: list X),
GU ++ GL = GH1 ++ GH0 ->
length GU = length GH1 ->
GU=GH1 /\ GL=GH0.
Proof.
intros. generalize dependent GH1. induction GU; intros.
- simpl in H0. induction GH1. rewrite app_nil_l in H. rewrite app_nil_l in H.
split. reflexivity. apply H.
simpl in H0. omega.
- simpl in H0. induction GH1. simpl in H0. omega.
simpl in H0. inversion H0. simpl in H. inversion H. specialize (IHGU GH1 H4 H2).
destruct IHGU. subst. split; reflexivity.
Qed.
Lemma concat_same_length': forall {X} (GU: list X) (GL: list X) (GH1: list X) (GH0: list X),
GU ++ GL = GH1 ++ GH0 ->
length GL = length GH0 ->
GU=GH1 /\ GL=GH0.
Proof.
intros.
assert (length (GU ++ GL) = length (GH1 ++ GH0)) as A. {
rewrite H. reflexivity.
}
rewrite app_length in A. rewrite app_length in A.
rewrite H0 in A. apply NPeano.Nat.add_cancel_r in A.
apply concat_same_length; assumption.
Qed.
Lemma exists_GH1L: forall {X} (GU: list X) (GL: list X) (GH1: list X) (GH0: list X) x0,
length GL = S x0 ->
GU ++ GL = GH1 ++ GH0 ->
length GH0 <= x0 ->
exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ GH0.
Proof.
intros X GU. induction GU; intros.
- eexists. rewrite app_nil_l. split. reflexivity. simpl in H0. assumption.
- induction GH1.
simpl in H0.
assert (length (a :: GU ++ GL) = length GH0) as Contra. {
rewrite H0. reflexivity.
}
simpl in Contra. rewrite app_length in Contra. omega.
simpl in H0. inversion H0.
specialize (IHGU GL GH1 GH0 x0 H H4 H1).
destruct IHGU as [GH1L [IHA IHB]].
exists GH1L. split. simpl. rewrite IHA. reflexivity. apply IHB.
Qed.
Lemma exists_GH0U: forall {X} (GH1: list X) (GH0: list X) (GU: list X) (GL: list X) x0,
length GL = S x0 ->
GU ++ GL = GH1 ++ GH0 ->
x0 < length GH0 ->
exists GH0U, GH0 = GH0U ++ GL.
Proof.
intros X GH1. induction GH1; intros.
- simpl in H0. exists GU. symmetry. assumption.
- induction GU.
simpl in H0.
assert (length GL = length (a :: GH1 ++ GH0)) as Contra. {
rewrite H0. reflexivity.
}
simpl in Contra. rewrite app_length in Contra. omega.
simpl in H0. inversion H0.
specialize (IHGH1 GH0 GU GL x0 H H4 H1).
destruct IHGH1 as [GH0U IH].
exists GH0U. apply IH.
Qed.
Lemma stp2_splice : forall G1 T1 G2 T2 GH1 GH0 x v1 s m n1,
stp2 s m G1 T1 G2 T2 (GH1++GH0) n1 ->
stp2 s m G1 (splice (length GH0) T1) G2 (splice (length GH0) T2) ((map (spliceat (length GH0)) GH1) ++ (x,v1)::GH0) n1.
Proof.
intros G1 T1 G2 T2 GH1 GH0 x v1 s m n1 H. remember (GH1++GH0) as GH.
revert GH0 GH1 HeqGH.
induction H; intros; subst GH; simpl; eauto.
- Case "strong_sel1".
eapply stp2_strong_sel1. apply H. eassumption.
assert (splice (length GH0) TX' = TX') as B. {
eapply closed_splice_idem. eapply valtp_closed. eassumption. omega.
}
rewrite <- B. simpl in IHstp2_1. eapply IHstp2_1. reflexivity.
eassumption. eassumption.
assert (splice (length GH0) (open (varF f) TX)=(open (varF f) TX)) as A. {
eapply closed_splice_idem. eapply closed_open. eassumption. eauto. omega.
}
rewrite <- A. apply IHstp2_2.
reflexivity.
- Case "strong_sel2".
eapply stp2_strong_sel2. apply H. eassumption.
assert (splice (length GH0) TX' = TX') as B. {
eapply closed_splice_idem. eapply valtp_closed. eassumption. omega.
}
rewrite <- B. simpl in IHstp2_1. eapply IHstp2_1. reflexivity.
eassumption. eassumption.
assert (splice (length GH0) (open (varF f) TX)=(open (varF f) TX)) as A. {
eapply closed_splice_idem. eapply closed_open. eassumption. eauto. omega.
}
rewrite <- A. apply IHstp2_2.
reflexivity.
- Case "sel1".
eapply stp2_sel1. apply H. eassumption. assumption.
assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eassumption. omega.
}
rewrite <- A. apply IHstp2_1.
reflexivity.
apply IHstp2_2. reflexivity.
- Case "sel2".
eapply stp2_sel2. apply H. eassumption. assumption.
assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eassumption. omega.
}
rewrite <- A. apply IHstp2_1.
reflexivity.
apply IHstp2_2. reflexivity.
- Case "sela1".
case_eq (le_lt_dec (length GH0) x0); intros E LE.
+ assert (S x0 = x0 + 1) as EQ by omega.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stp2_sela1.
eapply indexr_spliceat_hi; eauto. rewrite <- HeqGH. eassumption.
eapply closed_upgrade_free.
eapply closed_splice in H0. eapply H0. omega.
instantiate (1:=(map (spliceat (length GH0)) GH1L) ++ (x, v1)::GH0).
rewrite app_length. simpl.
rewrite EQGL in H1. rewrite app_length in H1.
rewrite map_length. omega.
rewrite EQGH1. rewrite map_app. rewrite app_assoc. reflexivity.
eapply IHstp2_1; eauto.
apply IHstp2_2; eauto.
+ assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eassumption. omega.
}
assert (splice (length GH0) ((TMem l TBot T2))=((TMem l TBot T2))) as B. {
eapply closed_splice_idem. eapply stp2_closed2. eapply H3. rewrite H1. omega.
}
assert (exists GH0U, GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH0U EQGH].
eapply stp2_sela1. eapply indexr_spliceat_lo. rewrite <- HeqGH. apply H. eauto. eauto.
instantiate (1:=GL). eassumption.
rewrite EQGH. instantiate (1:=map (spliceat (length (GH0U ++ GL))) GH1 ++ (x, v1) :: GH0U). rewrite <- app_assoc. reflexivity.
eauto.
inversion B. rewrite H5. rewrite H5. eauto.
eapply IHstp2_2; eauto.
- Case "sela2".
case_eq (le_lt_dec (length GH0) x0); intros E LE.
+ assert (S x0 = x0 + 1) as EQ by omega.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stp2_sela2.
eapply indexr_spliceat_hi; eauto. rewrite <- HeqGH. eassumption.
eapply closed_upgrade_free.
eapply closed_splice in H0. eapply H0. omega.
instantiate (1:=(map (spliceat (length GH0)) GH1L) ++ (x, v1)::GH0).
rewrite app_length. simpl.
rewrite EQGL in H1. rewrite app_length in H1.
rewrite map_length. omega.
rewrite EQGH1. rewrite map_app. rewrite app_assoc. reflexivity.
eapply IHstp2_1; eauto.
apply IHstp2_2; eauto.
+ assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eassumption. omega.
}
assert (splice (length GH0) ((TMem l T1 TTop))=((TMem l T1 TTop))) as B. {
eapply closed_splice_idem. eapply stp2_closed2. eapply H3. rewrite H1. omega.
}
assert (exists GH0U, GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH0U EQGH].
eapply stp2_sela2. eapply indexr_spliceat_lo. rewrite <- HeqGH. apply H. eauto. eauto.
instantiate (1:=GL). eassumption.
rewrite EQGH. instantiate (1:=map (spliceat (length (GH0U ++ GL))) GH1 ++ (x, v1) :: GH0U). rewrite <- app_assoc. reflexivity.
eauto.
inversion B. rewrite H5. rewrite H5. eauto.
eapply IHstp2_2; eauto.
- Case "selab1".
case_eq (le_lt_dec (length GH0) x0); intros E LE.
+ assert (S x0 = x0 + 1) as EQ by omega.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stp2_selab1.
eapply indexr_spliceat_hi; eauto. rewrite <- HeqGH. eassumption.
eapply closed_upgrade_free.
eapply closed_splice in H0. eapply H0. omega.
instantiate (1:=(map (spliceat (length GH0)) GH1L) ++ (x, v1)::GH0).
rewrite app_length. simpl.
rewrite EQGL in H1. rewrite app_length in H1.
rewrite map_length. omega.
rewrite EQGH1. rewrite map_app. rewrite app_assoc. reflexivity.
eapply IHstp2_1. eauto. unfold open. rewrite splice_open_permute. assert (x0+0 = x0) as Z by eauto. rewrite Z. subst T2'. reflexivity. omega.
apply IHstp2_2; eauto.
+ assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eapply stp2_closed1. eauto. omega.
}
assert (splice (length GH0) (TBind (TMem l TBot T2))=(TBind (TMem l TBot T2))) as B. {
eapply closed_splice_idem. eapply stp2_closed. eauto. omega.
}
assert (exists GH0U, GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH0U EQGH].
eapply stp2_selab1.
eapply indexr_spliceat_lo; eauto. rewrite <- HeqGH. eassumption.
eassumption. eassumption.
rewrite EQGH. instantiate (1:=map (spliceat (length (GH0U ++ GL))) GH1 ++ (x, v1) :: GH0U). rewrite <- app_assoc. reflexivity.
eauto.
inversion B. rewrite H6. rewrite H4.
assert (closed 0 (length GL) (TBind (TMem l TBot T2))) as CB. eapply stp2_closed2; eauto.
erewrite closed_splice_idem. reflexivity.
inversion CB. inversion H9.
eapply closed_open. eapply closed_upgrade_free. eauto. instantiate (1:=(length GH0)). omega.
eapply cl_selh. eauto. eauto.
apply IHstp2_2; eauto.
- Case "selab2".
case_eq (le_lt_dec (length GH0) x0); intros E LE.
+ assert (S x0 = x0 + 1) as EQ by omega.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stp2_selab2.
eapply indexr_spliceat_hi; eauto. rewrite <- HeqGH. eassumption.
eapply closed_upgrade_free.
eapply closed_splice in H0. eapply H0. omega.
instantiate (1:=(map (spliceat (length GH0)) GH1L) ++ (x, v1)::GH0).
rewrite app_length. simpl.
rewrite EQGL in H1. rewrite app_length in H1.
rewrite map_length. omega.
rewrite EQGH1. rewrite map_app. rewrite app_assoc. reflexivity.
eapply IHstp2_1. eauto. unfold open. rewrite splice_open_permute. assert (x0+0 = x0) as Z by eauto. rewrite Z. subst T1'. reflexivity. omega.
apply IHstp2_2; eauto.
+ assert (splice (length GH0) TX=TX) as A. {
eapply closed_splice_idem. eapply stp2_closed1. eauto. omega.
}
assert (splice (length GH0) (TBind (TMem l T1 TTop))=(TBind (TMem l T1 TTop))) as B. {
eapply closed_splice_idem. eapply stp2_closed. eauto. omega.
}
assert (exists GH0U, GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. eassumption.
}
destruct EQGH as [GH0U EQGH].
eapply stp2_selab2.
eapply indexr_spliceat_lo; eauto. rewrite <- HeqGH. eassumption.
eassumption. eassumption.
rewrite EQGH. instantiate (1:=map (spliceat (length (GH0U ++ GL))) GH1 ++ (x, v1) :: GH0U). rewrite <- app_assoc. reflexivity.
eauto.
inversion B. rewrite H6. rewrite H4.
assert (closed 0 (length GL) (TBind (TMem l T1 TTop))) as CB. eapply stp2_closed2; eauto.
erewrite closed_splice_idem. reflexivity.
inversion CB. inversion H9.
eapply closed_open. eapply closed_upgrade_free. eauto. instantiate (1:=(length GH0)). omega.
eapply cl_selh. eauto. eauto.
apply IHstp2_2; eauto.
- Case "selax".
case_eq (le_lt_dec (length GH0) x0); intros E LE.
+ eapply stp2_selax.
eapply indexr_spliceat_hi. apply H. eauto.
+ eapply stp2_selax.
eapply indexr_spliceat_lo. apply H. eauto.
- Case "all".
eapply stp2_all.
eapply IHstp2_1. reflexivity.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
specialize IHstp2_2 with (GH2:=GH0) (GH3:=(0, (G1, T1)) :: GH1).
simpl in IHstp2_2. rewrite app_length. rewrite map_length. simpl.
repeat rewrite splice_open_permute with (j:=0).
rewrite app_length in IHstp2_2. simpl in IHstp2_2.
eapply IHstp2_2. reflexivity. omega.
specialize IHstp2_3 with (GH2:=GH0) (GH3:=(0, (G2, T3)) :: GH1).
simpl in IHstp2_3. rewrite app_length. rewrite map_length. simpl.
repeat rewrite splice_open_permute with (j:=0).
rewrite app_length in IHstp2_3. simpl in IHstp2_3.
eapply IHstp2_3. reflexivity. omega. omega.
- Case "bind".
eapply stp2_bind.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
rewrite app_length. rewrite map_length. simpl.
repeat rewrite splice_open_permute with (j:=0).
specialize IHstp2_1 with (GH2:=GH0) (GH3:=(0, (G2,(open (varH (length GH1 + length GH0)) T2)))::GH1).
rewrite app_length in IHstp2_1. simpl in IHstp2_1. unfold open in IHstp2_1.
eapply IHstp2_1. eauto. omega.
rewrite app_length. rewrite map_length. simpl.
repeat rewrite splice_open_permute with (j:=0).
specialize IHstp2_2 with (GH2:=GH0) (GH3:=(0, (G1,(open (varH (length GH1 + length GH0)) T1)))::GH1).
rewrite app_length in IHstp2_2. simpl in IHstp2_2. unfold open in IHstp2_2.
eapply IHstp2_2. eauto. omega. omega.
- Case "bind1".
eapply stp2_bind1.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
simpl. rewrite map_spliceat_length_inc. apply closed_splice. assumption.
eapply IHstp2_1. eauto.
rewrite app_length. rewrite map_length. simpl.
repeat rewrite splice_open_permute with (j:=0).
specialize IHstp2_2 with (GH2:=GH0) (GH3:=(0, (G1,(open (varH (length GH1 + length GH0)) T1)))::GH1).
rewrite app_length in IHstp2_2. simpl in IHstp2_2. unfold open in IHstp2_2.
eapply IHstp2_2. eauto. omega.
Grab Existential Variables.
apply 0. apply 0. apply 0. apply 0.
Qed.
Lemma indexr_at_index: forall {A} x0 GH0 GH1 x (v:A),
beq_nat x0 (length GH1) = true ->
indexr x0 (GH0 ++ (x, v) :: GH1) = Some v.
Proof.
intros. apply beq_nat_true in H. subst.
induction GH0.
- simpl. rewrite <- beq_nat_refl. reflexivity.
- destruct a. simpl.
rewrite app_length. simpl. rewrite <- plus_n_Sm. rewrite <- plus_Sn_m.
rewrite false_beq_nat. assumption. omega.
Qed.
Lemma indexr_same: forall {A} x0 (v0:A) GH0 GH1 x (v:A) (v':A),
beq_nat x0 (length GH1) = false ->
indexr x0 (GH0 ++ (x, v) :: GH1) = Some v0 ->
indexr x0 (GH0 ++ (x, v') :: GH1) = Some v0.
Proof.
intros ? ? ? ? ? ? ? ? E H.
induction GH0.
- simpl. rewrite E. simpl in H. rewrite E in H. apply H.
- destruct a. simpl.
rewrite app_length. simpl.
case_eq (beq_nat x0 (length GH0 + S (length GH1))); intros E'.
simpl in H. rewrite app_length in H. simpl in H. rewrite E' in H.
rewrite H. reflexivity.
simpl in H. rewrite app_length in H. simpl in H. rewrite E' in H.
rewrite IHGH0. reflexivity. assumption.
Qed.
Inductive venv_ext : venv -> venv -> Prop :=
| venv_ext_refl : forall G, venv_ext G G
| venv_ext_cons : forall x T G1 G2, fresh G1 <= x -> venv_ext G1 G2 -> venv_ext ((x,T)::G1) G2.
Inductive aenv_ext : aenv -> aenv -> Prop :=
| aenv_ext_nil : aenv_ext nil nil
| aenv_ext_cons : forall x T G' G A A', aenv_ext A' A -> venv_ext G' G -> aenv_ext ((x,(G',T))::A') ((x,(G,T))::A).
Lemma aenv_ext_refl: forall GH, aenv_ext GH GH.
Proof.
intros. induction GH.
- apply aenv_ext_nil.
- destruct a. destruct p. apply aenv_ext_cons.
assumption.
apply venv_ext_refl.
Qed.
Lemma index_extend_mult : forall G G' x T,
index x G = Some T ->
venv_ext G' G ->
index x G' = Some T.
Proof.
intros G G' x T H HV.
induction HV.
- assumption.
- apply index_extend. apply IHHV. apply H. assumption.
Qed.
Lemma aenv_ext__same_length:
forall GH GH',
aenv_ext GH' GH ->
length GH = length GH'.
Proof.
intros. induction H.
- simpl. reflexivity.
- simpl. rewrite IHaenv_ext. reflexivity.
Qed.
Lemma aenv_ext__concat:
forall GH GH' GU GL,
aenv_ext GH' GH ->
GH = GU ++ GL ->
exists GU' GL', GH' = GU' ++ GL' /\ aenv_ext GU' GU /\ aenv_ext GL' GL.
Proof.
intros. generalize dependent GU. generalize dependent GL. induction H.
- intros. symmetry in H0. apply app_eq_nil in H0. destruct H0.
exists []. exists []. simpl. split; eauto. subst. split. apply aenv_ext_refl. apply aenv_ext_refl.
- intros. induction GU. rewrite app_nil_l in H1. subst.
exists []. eexists. rewrite app_nil_l. split. reflexivity.
split. apply aenv_ext_refl.
apply aenv_ext_cons. eassumption. eassumption.
simpl in H1. inversion H1.
specialize (IHaenv_ext GL GU H4).
destruct IHaenv_ext as [GU' [GL' [IHA [IHU IHL]]]].
exists ((x, (G', T))::GU'). exists GL'.
split. simpl. rewrite IHA. reflexivity.
split. apply aenv_ext_cons. apply IHU. assumption. apply IHL.
Qed.
Lemma indexr_at_ext :
forall GH GH' x T G,
aenv_ext GH' GH ->
indexr x GH = Some (G, T) ->
exists G', indexr x GH' = Some (G', T) /\ venv_ext G' G.
Proof.
intros GH GH' x T G Hext Hindex. induction Hext.
- simpl in Hindex. inversion Hindex.
- simpl. simpl in Hindex.
case_eq (beq_nat x (length A)); intros E.
rewrite E in Hindex. inversion Hindex. subst.
rewrite <- (@aenv_ext__same_length A A'). rewrite E.
exists G'. split. reflexivity. assumption. assumption.
rewrite E in Hindex.
rewrite <- (@aenv_ext__same_length A A'). rewrite E.
apply IHHext. assumption. assumption.
Qed.
Lemma stp2_closure_extend_rec :
forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
(forall G1' G2' GH',
aenv_ext GH' GH ->
venv_ext G1' G1 ->
venv_ext G2' G2 ->
stp2 s m G1' T1 G2' T2 GH' n1).
Proof.
intros G1 G2 T1 T2 GH s m n1 H.
induction H; intros; eauto;
try solve [inversion IHstp2_1; inversion IHstp2_2; eauto];
try solve [inversion IHstp2; eauto].
- Case "strong_sel1".
eapply stp2_strong_sel1. eapply index_extend_mult. apply H.
assumption. eassumption.
apply IHstp2_1. assumption. apply venv_ext_refl. assumption.
eassumption. assumption.
apply IHstp2_2. assumption. apply venv_ext_refl. assumption.
- Case "strong_sel2".
eapply stp2_strong_sel2. eapply index_extend_mult. apply H.
assumption. eassumption.
apply IHstp2_1. assumption. apply venv_ext_refl. assumption.
eassumption. assumption.
apply IHstp2_2. assumption. assumption. apply venv_ext_refl.
- Case "strong_selx".
eapply stp2_strong_selx.
eapply index_extend_mult. apply H. assumption.
eapply index_extend_mult. apply H0. assumption.
- Case "sel1".
eapply stp2_sel1. eapply index_extend_mult. apply H.
assumption. eassumption. assumption.
apply IHstp2_1. assumption. apply venv_ext_refl. assumption.
apply IHstp2_2. assumption. assumption. assumption.
- Case "sel2".
eapply stp2_sel2. eapply index_extend_mult. apply H.
assumption. eassumption. assumption.
apply IHstp2_1. assumption. apply venv_ext_refl. assumption.
apply IHstp2_2. assumption. assumption. assumption.
- Case "selx".
eapply stp2_selx.
eapply index_extend_mult. apply H. assumption.
eapply index_extend_mult. apply H0. assumption.
- Case "sela1".
assert (exists GX', indexr x GH' = Some (GX', TX) /\ venv_ext GX' GX) as A. {
apply indexr_at_ext with (GH:=GH); assumption.
}
inversion A as [GX' [H' HX]].
assert (exists GU' GL', GH' = GU' ++ GL' /\ aenv_ext GU' GU /\ aenv_ext GL' GL) as B. {
eapply aenv_ext__concat. eassumption. eassumption.
}
destruct B as [GU' [GL' [BEQ [BU BL]]]].
apply stp2_sela1 with (GX:=GX') (TX:=TX) (GL:=GL') (GU:=GU').
assumption. assumption.
rewrite <- H1. symmetry. apply aenv_ext__same_length. eassumption.
eassumption.
apply IHstp2_1; assumption.
apply IHstp2_2; assumption.
- Case "sela2".
assert (exists GX', indexr x GH' = Some (GX', TX) /\ venv_ext GX' GX) as A. {
apply indexr_at_ext with (GH:=GH); assumption.
}
inversion A as [GX' [H' HX]].
assert (exists GU' GL', GH' = GU' ++ GL' /\ aenv_ext GU' GU /\ aenv_ext GL' GL) as B. {
eapply aenv_ext__concat. eassumption. eassumption.
}
destruct B as [GU' [GL' [BEQ [BU BL]]]].
apply stp2_sela2 with (GX:=GX') (TX:=TX) (GL:=GL') (GU:=GU').
assumption. assumption.
rewrite <- H1. symmetry. apply aenv_ext__same_length. eassumption.
eassumption.
apply IHstp2_1; assumption.
apply IHstp2_2; assumption.
- Case "selab1".
assert (exists GX', indexr x GH' = Some (GX', TX) /\ venv_ext GX' GX) as A. {
apply indexr_at_ext with (GH:=GH); assumption.
}
inversion A as [GX' [H' HX]].
assert (exists GU' GL', GH' = GU' ++ GL' /\ aenv_ext GU' GU /\ aenv_ext GL' GL) as B. {
eapply aenv_ext__concat. eassumption. eassumption.
}
destruct B as [GU' [GL' [BEQ [BU BL]]]].
eapply stp2_selab1 with (GX:=GX') (TX:=TX) (GL:=GL') (GU:=GU').
assumption. eassumption.
rewrite <- H1. symmetry. apply aenv_ext__same_length. eassumption.
eassumption.
apply IHstp2_1; eauto.
eassumption.
apply IHstp2_2; eauto.
- Case "selab2".
assert (exists GX', indexr x GH' = Some (GX', TX) /\ venv_ext GX' GX) as A. {
apply indexr_at_ext with (GH:=GH); assumption.
}
inversion A as [GX' [H' HX]].
assert (exists GU' GL', GH' = GU' ++ GL' /\ aenv_ext GU' GU /\ aenv_ext GL' GL) as B. {
eapply aenv_ext__concat. eassumption. eassumption.
}
destruct B as [GU' [GL' [BEQ [BU BL]]]].
eapply stp2_selab2 with (GX:=GX') (TX:=TX) (GL:=GL') (GU:=GU').
assumption. eassumption.
rewrite <- H1. symmetry. apply aenv_ext__same_length. eassumption.
eassumption.
apply IHstp2_1; eauto.
eassumption.
apply IHstp2_2; eauto.
- Case "selax".
assert (exists GX', indexr x GH' = Some (GX', TX) /\ venv_ext GX' GX) as A. {
apply indexr_at_ext with (GH:=GH); assumption.
}
inversion A as [GX' [H' HX]].
apply stp2_selax with (GX:=GX') (TX:=TX).
assumption.
- Case "all".
assert (length GH = length GH') as A. {
apply aenv_ext__same_length. assumption.
}
apply stp2_all.
apply IHstp2_1; assumption.
subst. rewrite <- A. assumption.
subst. rewrite <- A. assumption.
subst. rewrite <- A.
apply IHstp2_2. apply aenv_ext_cons. assumption. assumption. assumption. assumption.
subst. rewrite <- A.
apply IHstp2_3. apply aenv_ext_cons. assumption. assumption. assumption. assumption.
- Case "bind".
assert (length GH = length GH') as A. {
apply aenv_ext__same_length. assumption.
}
apply stp2_bind.
subst. rewrite A in H. assumption.
subst. rewrite A in H0. assumption.
rewrite A in IHstp2_1. apply IHstp2_1. apply aenv_ext_cons. assumption. assumption. assumption. assumption.
subst.
rewrite A in IHstp2_2. apply IHstp2_2. apply aenv_ext_cons. assumption. assumption. assumption. assumption.
- Case "bind1".
assert (length GH = length GH') as A. {
apply aenv_ext__same_length. assumption.
}
apply stp2_bind1.
subst. rewrite A in H. assumption.
subst. rewrite A in H0. assumption.
apply IHstp2_1. assumption. assumption. assumption.
subst.
rewrite A in IHstp2_2. apply IHstp2_2. apply aenv_ext_cons. assumption. assumption. assumption. assumption.
- Case "trans".
eapply stp2_transf.
eapply IHstp2_1.
assumption. assumption. apply venv_ext_refl.
eapply IHstp2_2.
assumption. apply venv_ext_refl. assumption.
Qed.
Lemma stp2_closure_extend : forall G1 T1 G2 T2 GH GX T x v s m n1,
stp2 s m G1 T1 G2 T2 ((0,(GX,T))::GH) n1 ->
fresh GX <= x ->
stp2 s m G1 T1 G2 T2 ((0,((x,v)::GX,T))::GH) n1.
Proof.
intros. eapply stp2_closure_extend_rec. apply H.
apply aenv_ext_cons. apply aenv_ext_refl. apply venv_ext_cons.
assumption. apply venv_ext_refl. apply venv_ext_refl. apply venv_ext_refl.
Qed.
Lemma stp2_extend : forall x v1 G1 G2 T1 T2 H s m n1,
stp2 s m G1 T1 G2 T2 H n1 ->
(fresh G1 <= x ->
stp2 s m ((x,v1)::G1) T1 G2 T2 H n1) /\
(fresh G2 <= x ->
stp2 s m G1 T1 ((x,v1)::G2) T2 H n1) /\
(fresh G1 <= x -> fresh G2 <= x ->
stp2 s m ((x,v1)::G1) T1 ((x,v1)::G2) T2 H n1).
Proof.
intros. induction H0;
try solve [split; try split; repeat ev; intros; eauto using index_extend];
try solve [split; try split; intros; inversion IHstp2_1 as [? [? ?]]; inversion IHstp2_2 as [? [? ?]]; inversion IHstp2_3 as [? [? ?]]; constructor; eauto; apply stp2_closure_extend; eauto];
try solve [split; try split; intros; inversion IHstp2_1 as [? [? ?]]; inversion IHstp2_2 as [? [? ?]]; eapply stp2_bind; eauto; apply stp2_closure_extend; eauto];
try solve [split; try split; intros; inversion IHstp2_1 as [? [? ?]]; inversion IHstp2_2 as [? [? ?]]; eapply stp2_bind1; eauto; apply stp2_closure_extend; eauto].
Qed.
Lemma stp2_extend2 : forall x v1 G1 G2 T1 T2 H s m n1,
stp2 s m G1 T1 G2 T2 H n1 ->
fresh G2 <= x ->
stp2 s m G1 T1 ((x,v1)::G2) T2 H n1.
Proof.
intros. apply (proj2 (stp2_extend x v1 G1 G2 T1 T2 H s m n1 H0)). assumption.
Qed.
Lemma stp2_extend1 : forall x v1 G1 G2 T1 T2 H s m n1,
stp2 s m G1 T1 G2 T2 H n1 ->
fresh G1 <= x ->
stp2 s m ((x,v1)::G1) T1 G2 T2 H n1.
Proof.
intros. apply (proj1 (stp2_extend x v1 G1 G2 T1 T2 H s m n1 H0)). assumption.
Qed.
Lemma stp2_extendH : forall x v1 G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
stp2 s m G1 T1 G2 T2 ((x,v1)::GH) n1.
Proof.
intros. induction H; eauto using indexr_extend.
- Case "sela1".
eapply stp2_sela1; try eassumption. eapply indexr_extend. eassumption.
rewrite H2. instantiate (1:=(x, v1)::GU). simpl. reflexivity.
- Case "sela2".
eapply stp2_sela2; try eassumption. eapply indexr_extend. eassumption.
rewrite H2. instantiate (1:=(x, v1)::GU). simpl. reflexivity.
- Case "selab1".
eapply stp2_selab1; try eassumption. eapply indexr_extend. eassumption.
rewrite H2. instantiate (1:=(x, v1)::GU). simpl. reflexivity.
- Case "selab2".
eapply stp2_selab2; try eassumption. eapply indexr_extend. eassumption.
rewrite H2. instantiate (1:=(x, v1)::GU). simpl. reflexivity.
- Case "all".
assert (splice (length GH) T2 = T2) as A2. {
eapply closed_splice_idem. apply H0. omega.
}
assert (splice (length GH) T4 = T4) as A4. {
eapply closed_splice_idem. apply H1. omega.
}
(*
assert (TSel (varH (S (length GH))) = splice (length GH) (TSel (varH (length GH)))) as AH. {
simpl. case_eq (le_lt_dec (length GH) (length GH)); intros E LE.
simpl. rewrite NPeano.Nat.add_1_r. reflexivity.
clear LE. apply lt_irrefl in E. inversion E.
}
*)
assert (closed 0 (length GH) T1). eapply stp2_closed2. eauto.
assert (splice (length GH) T1 = T1) as A1. {
eapply closed_splice_idem. eauto. omega.
}
assert (map (spliceat (length GH)) [(0,(G1, T1))] ++(x,v1)::GH =((0, (G1, T1))::(x,v1)::GH)) as HGX1. {
simpl. rewrite A1. eauto.
}
assert (closed 0 (length GH) T3). eapply stp2_closed1. eauto.
assert (splice (length GH) T3 = T3) as A3. {
eapply closed_splice_idem. eauto. omega.
}
assert (map (spliceat (length GH)) [(0,(G2, T3))] ++(x,v1)::GH =((0, (G2, T3))::(x,v1)::GH)) as HGX3. {
simpl. rewrite A3. eauto.
}
eapply stp2_all.
apply IHstp2_1.
apply closed_inc. apply H0.
apply closed_inc. apply H1.
simpl.
unfold open.
rewrite <- A2.
unfold open.
change (varH (S (length GH))) with (varH (0 + (S (length GH)))).
rewrite -> splice_open_permute.
rewrite <- HGX1.
apply stp2_splice.
simpl. unfold open in H2. apply H2.
simpl. omega.
rewrite <- A2. rewrite <- A4.
unfold open. simpl.
change (varH (S (length GH))) with (varH (0 + (S (length GH)))).
rewrite -> splice_open_permute.
rewrite -> splice_open_permute.
rewrite <- HGX3.
apply stp2_splice.
simpl. unfold open in H3. apply H3.
omega. omega.
- Case "bind".
assert (splice (length GH) T2 = T2) as A2. {
eapply closed_splice_idem. eauto. omega.
}
assert (splice (length GH) T1 = T1) as A1. {
eapply closed_splice_idem. eauto. omega.
}
eapply stp2_bind.
apply closed_inc. eauto.
apply closed_inc. eauto.
simpl.
unfold open.
rewrite <- A2.
change (varH (S (length GH))) with (varH (0 + (S (length GH)))).
rewrite -> splice_open_permute. simpl.
assert (
stp2 1 false G2 (splice (length GH) (open_rec 0 (varH (length GH)) T2))
G2 (splice (length GH) (open_rec 0 (varH (length GH)) T2))
((map (spliceat (length GH)) [(0, (G2, open_rec 0 (varH (length GH)) T2))])++((x, v1)::GH))
n2
->
stp2 1 false G2 (splice (length GH) (open_rec 0 (varH (length GH)) T2))
G2 (splice (length GH) (open_rec 0 (varH (length GH)) T2))
((0, (G2, splice (length GH) (open_rec 0 (varH (length GH)) T2)))
:: (x, v1) :: GH) n2
) as HGX1. {
simpl. intros A. apply A.
}
apply HGX1.
apply stp2_splice.
simpl. unfold open in H1. apply H1.
simpl. apply le_refl.
rewrite <- A1. rewrite <- A2.
unfold open. simpl.
change (varH (S (length GH))) with (varH (0 + (S (length GH)))).
rewrite -> splice_open_permute. rewrite -> splice_open_permute.
assert (
stp2 1 false G1
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T1)) G2
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T2))
((map (spliceat (length GH)) [(0, (G1, (open_rec 0 (varH (0 + length GH)) T1)))])++((x, v1) :: GH)) n1
->
stp2 1 false G1
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T1)) G2
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T2))
((0, (G1, splice (length GH) (open_rec 0 (varH (0 + length GH)) T1)))
:: (x, v1) :: GH) n1
) as HGX2. {
simpl. intros A. apply A.
}
apply HGX2.
apply stp2_splice.
simpl. unfold open in H2. apply H2.
simpl. apply le_refl. simpl. apply le_refl.
- Case "bind1".
assert (splice (length GH) T2 = T2) as A2. {
eapply closed_splice_idem. eauto. omega.
}
assert (splice (length GH) T1 = T1) as A1. {
eapply closed_splice_idem. eauto. omega.
}
eapply stp2_bind1.
apply closed_inc. eauto.
apply closed_inc. eauto.
assumption.
unfold open. simpl.
rewrite <- A2. rewrite <- A1.
change (varH (S (length GH))) with (varH (0 + (S (length GH)))).
rewrite -> splice_open_permute.
assert (
stp2 1 false G1
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T1)) G2
(splice (length GH) T2)
((map (spliceat (length GH)) [(0, (G1, (open_rec 0 (varH (0 + length GH)) T1)))])++((x, v1) :: GH)) n1
->
stp2 1 false G1
(splice (length GH) (open_rec 0 (varH (0 + length GH)) T1)) G2
(splice (length GH) T2)
((0, (G1, splice (length GH) (open_rec 0 (varH (0 + length GH)) T1))) :: (x, v1) :: GH) n1
) as HGX2. {
simpl. intros A. apply A.
}
apply HGX2.
apply stp2_splice.
simpl. unfold open in H2. apply H2.
simpl. apply le_refl.
Qed.
Lemma stp2_extendH_mult : forall G1 G2 T1 T2 H H2 s m n1,
stp2 s m G1 T1 G2 T2 H n1->
stp2 s m G1 T1 G2 T2 (H2++H) n1.
Proof. intros. induction H2.
simpl. eauto. destruct a.
simpl. eapply stp2_extendH. eauto.
Qed.
Lemma stp2_extendH_mult0 : forall G1 G2 T1 T2 H2 s m n1,
stp2 s m G1 T1 G2 T2 [] n1 ->
stp2 s m G1 T1 G2 T2 H2 n1.
Proof. intros. eapply stp2_extendH_mult with (H2:=H2) in H; eauto. rewrite app_nil_r in H. eauto. Qed.
Lemma stp2_reg : forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
(exists n0, stp2 s true G1 T1 G1 T1 GH n0) /\
(exists n0, stp2 s true G2 T2 G2 T2 GH n0).
Proof.
intros. induction H;
try solve [repeat ev; split; eexists; eauto 4].
- Case "all". repeat ev; split; eexists; eauto.
- Case "and11".
repeat ev; split; eexists.
eapply stp2_and2.
eapply stp2_wrapf. eapply stp2_and11; eassumption.
eapply stp2_wrapf. eapply stp2_and12; eassumption.
eassumption.
- Case "and12".
repeat ev; split; eexists.
eapply stp2_and2.
eapply stp2_wrapf. eapply stp2_and11; eassumption.
eapply stp2_wrapf. eapply stp2_and12; eassumption.
eassumption.
- Case "and2".
repeat ev; split; eexists.
eassumption.
eapply stp2_and2.
eapply stp2_wrapf. eapply stp2_and11; eassumption.
eapply stp2_wrapf. eapply stp2_and12; eassumption.
- Case "or21".
repeat ev; split; eexists.
eassumption.
eapply stp2_or1.
eapply stp2_or21; eauto.
eapply stp2_or22; eauto.
- Case "or22".
repeat ev; split; eexists.
eassumption.
eapply stp2_or1.
eapply stp2_or21; eauto.
eapply stp2_or22; eauto.
- Case "or1".
repeat ev; split; eexists.
eapply stp2_or1.
eapply stp2_or21; eauto.
eapply stp2_or22; eauto.
eassumption.
Grab Existential Variables.
apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0.
apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0.
apply 0. apply 0.
Qed.
Lemma stp2_reg2 : forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
(exists n0, stp2 s true G2 T2 G2 T2 GH n0).
Proof.
intros. apply (proj2 (stp2_reg G1 G2 T1 T2 GH s m n1 H)).
Qed.
Lemma stp2_reg1 : forall G1 G2 T1 T2 GH s m n1,
stp2 s m G1 T1 G2 T2 GH n1 ->
(exists n0, stp2 s true G1 T1 G1 T1 GH n0).
Proof.
intros. apply (proj1 (stp2_reg G1 G2 T1 T2 GH s m n1 H)).
Qed.
Lemma stp_reg : forall G GH T1 T2,
stp G GH T1 T2 ->
stp G GH T1 T1 /\ stp G GH T2 T2.
Proof.
intros. induction H;
try solve [repeat ev; split; eauto; try (eapply stp_selax; eapply tailr_to_indexr; eauto)].
Qed.
Lemma stpd2_extend2 : forall x v1 G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
fresh G2 <= x ->
stpd2 m G1 T1 ((x,v1)::G2) T2 H.
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extend2; assumption.
Qed.
Lemma stpd2_extend1 : forall x v1 G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
fresh G1 <= x ->
stpd2 m ((x,v1)::G1) T1 G2 T2 H.
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extend1; assumption.
Qed.
Lemma stpd2_extendH : forall x v1 G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
stpd2 m G1 T1 G2 T2 ((x,v1)::H).
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extendH; assumption.
Qed.
Lemma stpd2_extendH_mult : forall G1 G2 T1 T2 H H2 m,
stpd2 m G1 T1 G2 T2 H->
stpd2 m G1 T1 G2 T2 (H2++H).
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extendH_mult; assumption.
Qed.
Lemma stpd2_extendH_mult0 : forall G1 G2 T1 T2 H2 m,
stpd2 m G1 T1 G2 T2 [] ->
stpd2 m G1 T1 G2 T2 H2.
Proof.
intros. inversion H as [n1 Hsub]. exists n1.
apply stp2_extendH_mult0; assumption.
Qed.
Lemma stpd2_reg2 : forall G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
stpd2 true G2 T2 G2 T2 H.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_reg2; eassumption.
Qed.
Lemma stpd2_reg1 : forall G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
stpd2 true G1 T1 G1 T1 H.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_reg1; eassumption.
Qed.
Lemma stpd2_closed2 : forall G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
closed 0 (length H) T2.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_closed2; eassumption.
Qed.
Lemma stpd2_closed1 : forall G1 G2 T1 T2 H m,
stpd2 m G1 T1 G2 T2 H ->
closed 0 (length H) T1.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_closed1; eassumption.
Qed.
(* sstpd2 variants below *)
Lemma sstpd2_extend2 : forall x v1 G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
fresh G2 <= x ->
sstpd2 m G1 T1 ((x,v1)::G2) T2 H.
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extend2; assumption.
Qed.
Lemma sstpd2_extend1 : forall x v1 G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
fresh G1 <= x ->
sstpd2 m ((x,v1)::G1) T1 G2 T2 H.
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extend1; assumption.
Qed.
Lemma sstpd2_extendH : forall x v1 G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
sstpd2 m G1 T1 G2 T2 ((x,v1)::H).
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extendH; assumption.
Qed.
Lemma sstpd2_extendH_mult : forall G1 G2 T1 T2 H H2 m,
sstpd2 m G1 T1 G2 T2 H->
sstpd2 m G1 T1 G2 T2 (H2++H).
Proof.
intros. inversion H0 as [n1 Hsub]. exists n1.
apply stp2_extendH_mult; assumption.
Qed.
Lemma sstpd2_extendH_mult0 : forall G1 G2 T1 T2 H2 m,
sstpd2 m G1 T1 G2 T2 [] ->
sstpd2 m G1 T1 G2 T2 H2.
Proof.
intros. inversion H as [n1 Hsub]. exists n1.
apply stp2_extendH_mult0; assumption.
Qed.
Lemma sstpd2_reg2 : forall G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
sstpd2 true G2 T2 G2 T2 H.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_reg2; eassumption.
Qed.
Lemma sstpd2_reg1 : forall G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
sstpd2 true G1 T1 G1 T1 H.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_reg1; eassumption.
Qed.
Lemma sstpd2_closed2 : forall G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
closed 0 (length H) T2.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_closed2; eassumption.
Qed.
Lemma sstpd2_closed1 : forall G1 G2 T1 T2 H m,
sstpd2 m G1 T1 G2 T2 H ->
closed 0 (length H) T1.
Proof.
intros. inversion H0 as [n1 Hsub].
eapply stp2_closed1; eassumption.
Qed.
Lemma valtp_extend : forall vs v x v1 T n,
val_type vs v T n ->
fresh vs <= x ->
val_type ((x,v1)::vs) v T n.
Proof.
intros. induction H; eauto; econstructor; eauto; eapply sstpd2_extend2; eauto.
Qed.
Lemma index_safe_ex: forall H1 G1 TF i,
wf_env H1 G1 ->
index i G1 = Some TF ->
exists v n, index i H1 = Some v /\ val_type H1 v TF n.
Proof. intros. induction H.
- Case "nil". inversion H0.
- Case "cons". inversion H0.
case_eq (le_lt_dec (fresh ts) n); intros ? E1.
+ SCase "ok".
rewrite E1 in H3.
assert ((fresh ts) <= n) as QF. eauto. rewrite <-(wf_fresh vs ts H1) in QF.
elim (le_xx (fresh vs) n QF). intros ? EX.
case_eq (beq_nat i n); intros E2.
* SSCase "hit".
assert (index i ((n, v) :: vs) = Some v). eauto. unfold index. rewrite EX. rewrite E2. eauto.
assert (t = TF).
unfold index in H0. rewrite E1 in H0. rewrite E2 in H0. inversion H0. eauto.
subst t. eauto.
* SSCase "miss".
rewrite E2 in H3.
assert (exists v0 n0, index i vs = Some v0 /\ val_type vs v0 TF n0) as HI. eapply IHwf_env. eauto.
inversion HI as [v0 [n0 HI1]]. inversion HI1.
eexists. eexists. econstructor. eapply index_extend; eauto. eapply valtp_extend; eauto.
+ SSCase "bad".
rewrite E1 in H3. inversion H3.
Qed.
Lemma index_exists: forall H1 G1 TF i,
wf_env H1 G1 ->
index i G1 = Some TF ->
exists v, index i H1 = Some v.
Proof.
intros.
assert (exists v n, index i H1 = Some v /\ val_type H1 v TF n) as A. {
eapply index_safe_ex; eauto.
}
destruct A as [v [n [A1 A2]]].
exists v. apply A1.
Qed.
Lemma index_safeh_ex: forall H1 H2 G1 GH TF i,
wf_env H1 G1 -> wf_envh H1 H2 GH ->
indexr i GH = Some TF ->
exists v, indexr i H2 = Some v /\ valh_type H1 H2 v TF.
Proof. intros. induction H0.
- Case "nil". inversion H3.
- Case "cons". inversion H3.
case_eq (beq_nat i (length ts)); intros E2.
* SSCase "hit".
rewrite E2 in H2. inversion H2. subst. clear H2.
assert (length ts = length vs). symmetry. eapply wfh_length. eauto.
simpl. rewrite H1 in E2. rewrite E2.
eexists. split. eauto. econstructor.
* SSCase "miss".
rewrite E2 in H2.
assert (exists v : venv * ty,
indexr i vs = Some v /\ valh_type vvs vs v TF). eauto.
destruct H1. destruct H1.
eexists. split. eapply indexr_extend. eauto.
inversion H4. subst.
eapply v_tya. (* aenv is not constrained -- bit of a cheat?*)
Qed.
Lemma indexr_exists: forall H1 H2 GH TF i,
wf_envh H1 H2 GH ->
indexr i GH = Some TF ->
exists v, indexr i H2 = Some v.
Proof.
intros. induction H.
- inversion H0.
- unfold indexr.
case_eq (beq_nat i (length vs)); intros E.
+ eexists. reflexivity.
+ eapply IHwf_envh. unfold indexr in H0.
assert (length vs = length ts) as A. {
eapply wfh_length. eauto.
}
rewrite <- A in H0. rewrite E in H0. unfold indexr. apply H0.
Qed.
Inductive res_type: venv -> option vl -> ty -> Prop :=
| not_stuck: forall venv v T n,
val_type venv v T n ->
res_type venv (Some v) T.
Hint Constructors res_type.
Hint Resolve not_stuck.
Lemma sstpd2_downgrade_true: forall G1 G2 T1 T2 H,
sstpd2 true G1 T1 G2 T2 H ->
stpd2 true G1 T1 G2 T2 H.
Proof.
intros. inversion H0. remember 0 as m. induction H1;
try solve [eexists; eauto]; try solve [inversion Heqm].
- Case "top".
eapply stpd2_top. eapply IHstp2. eapply sstpd2_reg1. eassumption. eauto.
- Case "bot".
eapply stpd2_bot. eapply IHstp2. eapply sstpd2_reg2. eassumption. eauto.
- Case "mem".
eapply stpd2_mem.
eapply IHstp2_1; eauto. eexists. eassumption.
eapply stpd2_wrapf. eapply IHstp2_2; eauto. eexists. eassumption.
- Case "sel1".
eapply stpd2_sel1.
eassumption. eassumption. eapply valtp_closed. eassumption.
eapply IHstp2_1. eexists. eassumption. eauto.
eapply stpd2_reg2. eapply IHstp2_2. eexists. eassumption. eauto.
- Case "sel2".
eapply stpd2_sel2.
eassumption. eassumption. eapply valtp_closed. eassumption.
eapply IHstp2_1. eexists. eassumption. eauto.
eapply stpd2_reg1. eapply IHstp2_2. eexists. eassumption. eauto.
- Case "selx".
eapply stpd2_selx; eauto.
- Case "bind1".
eapply stpd2_bind1; eauto. subst m. eapply IHstp2_1. eexists. eassumption. reflexivity.
- Case "and11".
eapply stpd2_and11; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "and12".
eapply stpd2_and12; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "and2".
eapply stpd2_and2; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "or21".
eapply stpd2_or21; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "or22".
eapply stpd2_or22; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "or1".
eapply stpd2_or1; eauto.
eapply IHstp2_1; eauto. eexists. rewrite <- Heqm. eassumption.
eapply IHstp2_2; eauto. eexists. rewrite <- Heqm. eassumption.
- Case "wrap". destruct m.
+ eapply stpd2_wrapf. eapply IHstp2. eexists. eassumption. eauto.
+ inversion Heqm.
- Case "trans". destruct m.
+ eapply stpd2_transf. eapply IHstp2_1. eexists; eauto. eauto.
eapply IHstp2_2. eexists. eauto. eauto.
+ inversion Heqm.
Grab Existential Variables.
apply 0. apply 0. apply 0.
Qed.
Lemma sstpd2_downgrade: forall G1 G2 T1 T2 H,
sstpd2 true G1 T1 G2 T2 H ->
stpd2 false G1 T1 G2 T2 H.
Proof.
intros. eapply stpd2_wrapf. eapply sstpd2_downgrade_true. eassumption.
Qed.
Lemma stpd2_trans_aux: forall n, forall G1 G2 G3 T1 T2 T3 H n1,
stp2 MAX false G1 T1 G2 T2 H n1 -> n1 < n ->
stpd2 false G2 T2 G3 T3 H ->
stpd2 false G1 T1 G3 T3 H.
Proof.
intros n. induction n; intros; try omega; repeat eu; subst; inversion H0.
- Case "wrapf". eapply stpd2_transf; eauto.
- Case "transf". eapply stpd2_transf. eauto. eapply IHn. eauto. omega. eauto.
Qed.
Lemma sstpd2_trans_axiom_aux: forall n, forall G1 G2 G3 T1 T2 T3 H n1,
stp2 0 false G1 T1 G2 T2 H n1 -> n1 < n ->
sstpd2 false G2 T2 G3 T3 H ->
sstpd2 false G1 T1 G3 T3 H.
Proof.
intros n. induction n; intros; try omega; repeat eu; subst; inversion H0.
- Case "wrapf". eapply sstpd2_transf. eexists. eauto. eexists. eauto.
- Case "transf". eapply sstpd2_transf. eexists. eauto. eapply IHn. eauto. omega. eexists. eauto.
Qed.
Lemma stpd2_trans: forall G1 G2 G3 T1 T2 T3 H,
stpd2 false G1 T1 G2 T2 H ->
stpd2 false G2 T2 G3 T3 H ->
stpd2 false G1 T1 G3 T3 H.
Proof. intros. repeat eu. eapply stpd2_trans_aux; eauto. Qed.
Lemma sstpd2_trans_axiom: forall G1 G2 G3 T1 T2 T3 H,
sstpd2 false G1 T1 G2 T2 H ->
sstpd2 false G2 T2 G3 T3 H ->
sstpd2 false G1 T1 G3 T3 H.
Proof. intros. repeat eu.
eapply sstpd2_trans_axiom_aux; eauto.
eexists. eauto.
Qed.
Lemma stp2_narrow_aux: forall n, forall m G1 T1 G2 T2 GH n0,
stp2 MAX m G1 T1 G2 T2 GH n0 ->
n0 <= n ->
forall x GH1 GH0 GH' GX1 TX1 GX2 TX2,
GH=GH1++[(x,(GX2,TX2))]++GH0 ->
GH'=GH1++[(x,(GX1,TX1))]++GH0 ->
stpd2 false GX1 TX1 GX2 TX2 ([(x,(GX1,TX1))]++GH0) ->
stpd2 m G1 T1 G2 T2 GH'.
Proof.
intros n.
induction n.
- Case "z". intros. inversion H0. subst. inversion H; eauto.
- Case "s n". intros m G1 T1 G2 T2 GH n0 H NE. inversion H; subst;
intros x0 GH1 GH0 GH' GX1 TX1 GX2 TX2 EGH EGH' HX.
+ SCase "top-top". eauto.
+ SCase "bot-bot". eauto.
+ SCase "top". eapply stpd2_top. eapply IHn; try eassumption. omega.
+ SCase "bot". eapply stpd2_bot. eapply IHn; try eassumption. omega.
+ SCase "bool". eauto.
+ SCase "mem". eapply stpd2_mem.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "sel1". eapply stpd2_sel1; try eassumption.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "sel2". eapply stpd2_sel2; try eassumption.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "selx". eapply stpd2_selx; try eassumption.
+ SCase "sela1".
case_eq (beq_nat x (length GH0)); intros E.
* assert (indexr x ([(x0, (GX2, TX2))]++GH0) = Some (GX2, TX2)) as A2. {
simpl. rewrite E. reflexivity.
}
assert (indexr x (GU ++ GL) = Some (GX2, TX2)) as A2'. {
rewrite EGH. eapply indexr_extend_mult. apply A2.
}
rewrite A2' in H1. inversion H1. subst.
inversion HX as [nx HX'].
eapply stpd2_sela1.
eapply indexr_extend_mult. simpl. rewrite E. reflexivity.
eapply stpd2_closed1 in HX. simpl in HX. eapply beq_nat_true in E. rewrite E. eapply HX.
instantiate (1:=([(x0, (GX1, TX1))]++GH0)). simpl. apply beq_nat_true in E. rewrite E. reflexivity.
reflexivity.
eapply stpd2_trans. eapply HX.
eapply IHn; try eassumption. omega. rewrite app_nil_l.
eapply proj2. eapply concat_same_length'. eassumption.
eapply beq_nat_true in E. subst. eauto.
simpl. reflexivity.
eapply IHn; try eassumption. omega.
reflexivity.
* assert (indexr x GH' = Some (GX, TX)) as A. {
subst.
eapply indexr_same. apply E. rewrite EGH in H1. eassumption.
}
simpl in EGH. simpl in EGH'. simpl in IHn. simpl in HX.
case_eq (le_lt_dec (S (length GH0)) x); intros E' LE'.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ (x0, (GX2, TX2)) :: GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stpd2_sela1 with (GH:=GH'). eapply A.
eassumption.
instantiate (1:=GH1L ++ (x0, (GX1, TX1)) :: GH0).
rewrite app_length. simpl.
rewrite EQGL in H3. rewrite app_length in H3. simpl in H3. eassumption.
instantiate (1:=GU). rewrite app_assoc. rewrite EQGH1 in EGH'. assumption.
eapply IHn; try eassumption. omega. reflexivity.
eapply IHn; try eassumption. omega.
assert (exists GH0U, (x0, (GX2, TX2))::GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH0U EQGH].
destruct GH0U. simpl in EQGH.
assert (length ((x0, (GX2, TX2))::GH0)=length GL) as Contra. {
rewrite EQGH. reflexivity.
}
simpl in Contra. rewrite H3 in Contra. inversion Contra. apply beq_nat_false in E. omega.
simpl in EQGH. inversion EQGH.
eapply stpd2_sela1 with (GH:=GH'). eapply A.
eassumption. eassumption.
rewrite H7 in EGH'. simpl in EGH'. instantiate (1:=GH1 ++ (x0, (GX1, TX1)) :: GH0U).
rewrite <- app_assoc. simpl. eapply EGH'.
eexists. eassumption.
eapply IHn; try eassumption. omega.
+ SCase "sela2".
case_eq (beq_nat x (length GH0)); intros E.
* assert (indexr x ([(x0, (GX2, TX2))]++GH0) = Some (GX2, TX2)) as A2. {
simpl. rewrite E. reflexivity.
}
assert (indexr x (GU ++ GL) = Some (GX2, TX2)) as A2'. {
rewrite EGH. eapply indexr_extend_mult. apply A2.
}
rewrite A2' in H1. inversion H1. subst.
inversion HX as [nx HX'].
eapply stpd2_sela2.
eapply indexr_extend_mult. simpl. rewrite E. reflexivity.
eapply stpd2_closed1 in HX. simpl in HX. eapply beq_nat_true in E. rewrite E. eapply HX.
instantiate (1:=([(x0, (GX1, TX1))]++GH0)). simpl. apply beq_nat_true in E. rewrite E. reflexivity.
reflexivity.
eapply stpd2_trans. eapply HX.
eapply IHn; try eassumption. omega. rewrite app_nil_l.
eapply proj2. eapply concat_same_length'. eassumption.
eapply beq_nat_true in E. subst. eauto.
simpl. reflexivity.
eapply IHn; try eassumption. omega.
reflexivity.
* assert (indexr x GH' = Some (GX, TX)) as A. {
subst.
eapply indexr_same. apply E. rewrite EGH in H1. eassumption.
}
simpl in EGH. simpl in EGH'. simpl in IHn. simpl in HX.
case_eq (le_lt_dec (S (length GH0)) x); intros E' LE'.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ (x0, (GX2, TX2)) :: GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stpd2_sela2 with (GH:=GH'). eapply A.
eassumption.
instantiate (1:=GH1L ++ (x0, (GX1, TX1)) :: GH0).
rewrite app_length. simpl.
rewrite EQGL in H3. rewrite app_length in H3. simpl in H3. eassumption.
instantiate (1:=GU). rewrite app_assoc. rewrite EQGH1 in EGH'. assumption.
eapply IHn; try eassumption. omega. reflexivity.
eapply IHn; try eassumption. omega.
assert (exists GH0U, (x0, (GX2, TX2))::GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH0U EQGH].
destruct GH0U. simpl in EQGH.
assert (length ((x0, (GX2, TX2))::GH0)=length GL) as Contra. {
rewrite EQGH. reflexivity.
}
simpl in Contra. rewrite H3 in Contra. inversion Contra. apply beq_nat_false in E. omega.
simpl in EQGH. inversion EQGH.
eapply stpd2_sela2 with (GH:=GH'). eapply A.
eassumption. eassumption.
rewrite H7 in EGH'. simpl in EGH'. instantiate (1:=GH1 ++ (x0, (GX1, TX1)) :: GH0U).
rewrite <- app_assoc. simpl. eapply EGH'.
eexists. eassumption.
eapply IHn; try eassumption. omega.
+ SCase "selab1".
case_eq (beq_nat x (length GH0)); intros E.
* assert (indexr x ([(x0, (GX2, TX2))]++GH0) = Some (GX2, TX2)) as A2. {
simpl. rewrite E. reflexivity.
}
assert (indexr x (GU ++ GL) = Some (GX2, TX2)) as A2'. {
rewrite EGH. eapply indexr_extend_mult. apply A2.
}
assert (Some (GX2,TX2) = Some (GX, TX)) as E2. {
rewrite A2' in H1. apply H1.
}
inversion E2. subst.
eapply stpd2_selab1.
eapply indexr_extend_mult. simpl. rewrite E. reflexivity.
eassumption.
instantiate (1:=([(x0, (GX1, TX1))]++GH0)). simpl. apply beq_nat_true in E. rewrite E. reflexivity.
reflexivity.
eapply stpd2_trans. eapply HX.
eapply IHn; try eassumption. omega. rewrite app_nil_l.
eapply proj2. eapply concat_same_length'. eassumption.
eapply beq_nat_true in E. subst. eauto.
simpl. reflexivity. reflexivity.
eapply IHn; try eassumption. omega.
reflexivity.
* assert (indexr x GH' = Some (GX, TX)) as A. {
subst.
eapply indexr_same. apply E. rewrite EGH in H1. eassumption.
}
simpl in EGH. simpl in EGH'. simpl in IHn. simpl in HX.
case_eq (le_lt_dec (S (length GH0)) x); intros E' LE'.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ (x0, (GX2, TX2)) :: GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stpd2_selab1 with (GH:=GH'). eapply A.
eassumption.
instantiate (1:=GH1L ++ (x0, (GX1, TX1)) :: GH0).
rewrite app_length. simpl.
rewrite EQGL in H3. rewrite app_length in H3. simpl in H3. eassumption.
instantiate (1:=GU). rewrite app_assoc. rewrite EQGH1 in EGH'. assumption.
eapply IHn; try eassumption. omega. reflexivity. reflexivity.
eapply IHn; try eassumption. omega.
assert (exists GH0U, (x0, (GX2, TX2))::GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH0U EQGH].
destruct GH0U. simpl in EQGH.
assert (length ((x0, (GX2, TX2))::GH0)=length GL) as Contra. {
rewrite EQGH. reflexivity.
}
simpl in Contra. rewrite H3 in Contra. inversion Contra. apply beq_nat_false in E. omega.
simpl in EQGH. inversion EQGH.
eapply stpd2_selab1 with (GH:=GH'). eapply A.
eassumption. eassumption.
rewrite H6 in EGH'. simpl in EGH'. instantiate (1:=GH1 ++ (x0, (GX1, TX1)) :: GH0U).
rewrite <- app_assoc. simpl. eapply EGH'.
eexists. eassumption. reflexivity.
eapply IHn; try eassumption. omega.
+ SCase "selab2".
case_eq (beq_nat x (length GH0)); intros E.
* assert (indexr x ([(x0, (GX2, TX2))]++GH0) = Some (GX2, TX2)) as A2. {
simpl. rewrite E. reflexivity.
}
assert (indexr x (GU ++ GL) = Some (GX2, TX2)) as A2'. {
rewrite EGH. eapply indexr_extend_mult. apply A2.
}
assert (Some (GX2,TX2) = Some (GX, TX)) as E2. {
rewrite A2' in H1. apply H1.
}
inversion E2. subst.
eapply stpd2_selab2.
eapply indexr_extend_mult. simpl. rewrite E. reflexivity.
eassumption.
instantiate (1:=([(x0, (GX1, TX1))]++GH0)). simpl. apply beq_nat_true in E. rewrite E. reflexivity.
reflexivity.
eapply stpd2_trans. eapply HX.
eapply IHn; try eassumption. omega. rewrite app_nil_l.
eapply proj2. eapply concat_same_length'. eassumption.
eapply beq_nat_true in E. subst. eauto.
simpl. reflexivity. reflexivity.
eapply IHn; try eassumption. omega.
reflexivity.
* assert (indexr x GH' = Some (GX, TX)) as A. {
subst.
eapply indexr_same. apply E. rewrite EGH in H1. eassumption.
}
simpl in EGH. simpl in EGH'. simpl in IHn. simpl in HX.
case_eq (le_lt_dec (S (length GH0)) x); intros E' LE'.
assert (exists GH1L, GH1 = GU ++ GH1L /\ GL = GH1L ++ (x0, (GX2, TX2)) :: GH0) as EQGH. {
eapply exists_GH1L. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH1L [EQGH1 EQGL]].
eapply stpd2_selab2 with (GH:=GH'). eapply A.
eassumption.
instantiate (1:=GH1L ++ (x0, (GX1, TX1)) :: GH0).
rewrite app_length. simpl.
rewrite EQGL in H3. rewrite app_length in H3. simpl in H3. eassumption.
instantiate (1:=GU). rewrite app_assoc. rewrite EQGH1 in EGH'. assumption.
eapply IHn; try eassumption. omega. reflexivity. reflexivity.
eapply IHn; try eassumption. omega.
assert (exists GH0U, (x0, (GX2, TX2))::GH0 = GH0U ++ GL) as EQGH. {
eapply exists_GH0U. eassumption. eassumption. simpl. eassumption.
}
destruct EQGH as [GH0U EQGH].
destruct GH0U. simpl in EQGH.
assert (length ((x0, (GX2, TX2))::GH0)=length GL) as Contra. {
rewrite EQGH. reflexivity.
}
simpl in Contra. rewrite H3 in Contra. inversion Contra. apply beq_nat_false in E. omega.
simpl in EQGH. inversion EQGH.
eapply stpd2_selab2 with (GH:=GH'). eapply A.
eassumption. eassumption.
rewrite H6 in EGH'. simpl in EGH'. instantiate (1:=GH1 ++ (x0, (GX1, TX1)) :: GH0U).
rewrite <- app_assoc. simpl. eapply EGH'.
eexists. eassumption. reflexivity.
eapply IHn; try eassumption. omega.
+ SCase "selax".
case_eq (beq_nat x (length GH0)); intros E.
* assert (indexr x ([(x0, (GX2, TX2))]++GH0) = Some (GX2, TX2)) as A2. {
simpl. rewrite E. reflexivity.
}
assert (indexr x GH = Some (GX2, TX2)) as A2'. {
rewrite EGH. eapply indexr_extend_mult. apply A2.
}
rewrite A2' in H1. inversion H1. subst.
inversion HX as [nx HX'].
eapply stpd2_selax.
eapply indexr_extend_mult. simpl. rewrite E. reflexivity.
* assert (indexr x GH' = Some (GX, TX)) as A. {
subst.
eapply indexr_same. apply E. eassumption.
}
eapply stpd2_selax. eapply A.
+ SCase "all".
assert (length GH = length GH') as A. {
subst. clear.
induction GH1.
- simpl. reflexivity.
- simpl. simpl in IHGH1. rewrite IHGH1. reflexivity.
}
eapply stpd2_all.
eapply IHn; try eassumption. omega.
rewrite <- A. assumption. rewrite <- A. assumption.
rewrite <- A. subst.
eapply IHn with (GH1:=(0, (G1, T0)) :: GH1); try eassumption. omega.
simpl. reflexivity. simpl. reflexivity.
rewrite <- A. subst.
eapply IHn with (GH1:=(0, (G2, T4)) :: GH1); try eassumption. omega.
simpl. reflexivity. simpl. reflexivity.
+ SCase "bind".
assert (length GH = length GH') as A. {
subst. clear.
induction GH1.
- simpl. reflexivity.
- simpl. simpl in IHGH1. rewrite IHGH1. reflexivity.
}
eapply stpd2_bind.
assert (closed 1 (length GH) T0 -> closed 1 (length GH') T0) as C0. {
rewrite A. intros P. apply P.
}
apply C0; assumption.
assert (closed 1 (length GH) T3 -> closed 1 (length GH') T3) as C3. {
rewrite A. intros P. apply P.
}
apply C3; assumption.
assert (
stpd2 false G2 (open (varH (length GH)) T3) G2
(open (varH (length GH)) T3)
((0, (G2, open (varH (length GH)) T3)) :: GH')
->
stpd2 false G2 (open (varH (length GH')) T3) G2
(open (varH (length GH')) T3)
((0, (G2, open (varH (length GH')) T3)) :: GH')) as CS1. {
rewrite A. intros P. apply P.
}
apply CS1. eapply IHn. eassumption. omega.
instantiate (5:=(0, (G2, open (varH (length GH)) T3)) :: GH1).
subst. simpl. reflexivity. subst. simpl. reflexivity.
assumption.
assert (
stpd2 false G1 (open (varH (length GH)) T0) G2
(open (varH (length GH)) T3)
((0, (G1, open (varH (length GH)) T0)) :: GH')
->
stpd2 false G1 (open (varH (length GH')) T0) G2
(open (varH (length GH')) T3)
((0, (G1, open (varH (length GH')) T0)) :: GH')
) as CS2. {
rewrite A. intros P. apply P.
}
apply CS2. eapply IHn. eassumption. omega.
instantiate (5:=(0, (G1, open (varH (length GH)) T0)) :: GH1).
subst. simpl. reflexivity. subst. simpl. reflexivity.
assumption.
+ SCase "bind1".
assert (length GH = length GH') as A. {
subst. clear.
induction GH1.
- simpl. reflexivity.
- simpl. simpl in IHGH1. rewrite IHGH1. reflexivity.
}
eapply stpd2_bind1.
assert (closed 1 (length GH) T0 -> closed 1 (length GH') T0) as C0. {
rewrite A. intros P. apply P.
}
apply C0; assumption.
rewrite <-A. eauto.
eapply IHn. eassumption. omega.
instantiate (5:=GH1).
subst. simpl. reflexivity. subst. simpl. reflexivity.
assumption.
assert (
stpd2 false G1 (open (varH (length GH)) T0) G2 T2
((0, (G1, open (varH (length GH)) T0)) :: GH')
->
stpd2 false G1 (open (varH (length GH')) T0) G2 T2
((0, (G1, open (varH (length GH')) T0)) :: GH')
) as CS2. {
rewrite A. intros P. apply P.
}
apply CS2. eapply IHn. eassumption. omega.
instantiate (5:=(0, (G1, open (varH (length GH)) T0)) :: GH1).
subst. simpl. reflexivity. subst. simpl. reflexivity.
assumption.
+ SCase "and11".
eapply stpd2_and11.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "and12".
eapply stpd2_and12.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "and2".
eapply stpd2_and2.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "or21".
eapply stpd2_or21.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "or22".
eapply stpd2_or22.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "or1".
eapply stpd2_or1.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
+ SCase "wrapf".
eapply stpd2_wrapf.
eapply IHn; try eassumption. omega.
+ SCase "transf".
eapply stpd2_transf.
eapply IHn; try eassumption. omega.
eapply IHn; try eassumption. omega.
Grab Existential Variables.
apply 0. apply 0. apply 0.
Qed.
Lemma stpd2_narrow: forall x G1 G2 G3 G4 GH T1 T2 T3 T4,
stpd2 false G1 T1 G2 T2 ((x,(G1,T1))::GH) -> (* careful about H! *)
stpd2 false G3 T3 G4 T4 ((x,(G2,T2))::GH) ->
stpd2 false G3 T3 G4 T4 ((x,(G1,T1))::GH).
Proof.
intros. inversion H0 as [n H'].
eapply (stp2_narrow_aux n) with (GH1:=[]). eapply H'. omega.
simpl. reflexivity. simpl. reflexivity.
assumption.
Qed.
Lemma sstpd2_trans_aux: forall n, forall m G1 G2 G3 T1 T2 T3 n1,
stp2 0 m G1 T1 G2 T2 nil n1 -> n1 < n ->
sstpd2 true G2 T2 G3 T3 nil ->
sstpd2 true G1 T1 G3 T3 nil.
Proof.
intros n. induction n; intros; try omega. eu.
inversion H.
- Case "topx". subst. inversion H1.
+ SCase "topx". eexists. eauto.
+ SCase "top". eexists. eauto.
+ SCase "sel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l TTop TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eapply stp2_topx.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "botx". subst. inversion H1.
+ SCase "botx". eexists. eauto.
+ SCase "top". eexists. eauto.
+ SCase "?". eexists. eauto.
+ SCase "sel2".
assert (sstpd2 false GX' TX' G1 (TMem l TBot TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf; eapply stp2_botx.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "top". subst. inversion H1.
+ SCase "topx". eexists. eauto.
+ SCase "top". eexists. eauto.
+ SCase "sel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l T1 TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eapply stp2_top. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "bot". subst.
apply stp2_reg2 in H1. inversion H1 as [n1' H1'].
exists (S n1'). apply stp2_bot. apply H1'.
- Case "bool". subst. inversion H1.
+ SCase "top". eexists. eauto.
+ SCase "bool". eexists. eauto.
+ SCase "sel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l TBool TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eapply stp2_bool.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "mem". subst. inversion H1.
+ SCase "top".
apply stp2_reg1 in H. inversion H. eexists. eapply stp2_top. eassumption.
+ SCase "mem". subst.
assert (sstpd2 false G3 T7 G1 T0 []) as A. {
eapply sstpd2_trans_axiom; eexists; eauto.
}
inversion A as [na A'].
assert (sstpd2 true G1 T4 G3 T8 []) as B. {
eapply IHn. eassumption. omega. eexists. eassumption.
}
inversion B as [nb B'].
eexists. eapply stp2_mem. apply A'. apply B'.
+ SCase "sel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l0 (TMem l T0 T4) TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "ssel1". subst.
assert (sstpd2 true ((f, vobj GX f ds) :: GX) (open (varF f) TX) G3 T3 []). eapply IHn. eauto. omega. eexists. eapply H1.
assert (sstpd2 false GX' TX' G3 (TMem l TBot T3) []). {
eapply sstpd2_wrapf. eapply IHn. eassumption. omega.
eexists. eapply stp2_mem.
eapply stp2_wrapf. eapply stp2_botx.
eapply H1.
}
repeat eu.
eexists. eapply stp2_strong_sel1; eauto.
- Case "ssel2". subst. inversion H1.
+ SCase "top". subst.
apply stp2_reg1 in H7. inversion H7.
eexists. eapply stp2_top. eassumption.
+ SCase "ssel1". (* interesting one *)
subst. rewrite H10 in H2. inversion H2.
subst. rewrite H13 in H5. inversion H5.
subst.
eapply IHn. eapply H7. omega. eexists. eauto.
+ SCase "ssel2". subst.
assert (sstpd2 false GX'0 TX'0 G1 (TMem l0 T1 TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "sselx".
subst. rewrite H2 in H10. inversion H10. subst.
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "sselx". subst. inversion H1.
+ SCase "top". subst.
apply stp2_reg1 in H. inversion H.
eexists. eapply stp2_top. eassumption.
+ SCase "ssel1".
subst. rewrite H6 in H3. inversion H3. subst.
eexists. eapply stp2_strong_sel1; eauto.
+ SCase "ssel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l0 (TSel (varF x1) l) TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "sselx".
subst. rewrite H6 in H3. inversion H3. subst.
eexists. eapply stp2_strong_selx. eauto. eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "all". subst. inversion H1.
+ SCase "top".
apply stp2_reg1 in H. inversion H.
eexists. eapply stp2_top. eassumption.
+ SCase "ssel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l0 (TAll l T0 T4) TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "all".
subst.
assert (stpd2 false G3 T7 G1 T0 []). eapply stpd2_trans. eauto. eauto.
assert (stpd2 false G1 (open (varH (length ([]:aenv))) T4)
G3 (open (varH (length ([]:aenv))) T8)
[(0, (G3, T7))]).
eapply stpd2_trans. eapply stpd2_narrow. eexists. eapply stp2_extendH_mult0. eapply H10. eauto. eauto.
repeat eu. eexists. eapply stp2_all. eauto. eauto. eauto. eauto. eapply H8.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "bind". subst. inversion H1; subst.
+ SCase "top".
apply stp2_reg1 in H. inversion H.
eexists. eapply stp2_top. eassumption.
+ SCase "ssel2". subst.
assert (sstpd2 false GX' TX' G1 (TMem l (TBind T0) TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "bind".
subst.
assert (stpd2 false G1 (open (varH 0) T0) G3 (open (varH 0) T2)
[(0, (G1, open (varH 0) T0))]) as A. {
simpl in H5. simpl in H9.
eapply stpd2_trans.
eexists; eauto.
change ([(0, (G1, open (varH 0) T0))]) with ((0, (G1, open (varH 0) T0))::[]).
eapply stpd2_narrow. eexists. eassumption. eexists. eassumption.
}
inversion A.
eexists. eapply stp2_bind; try eassumption.
+ SCase "bind1".
subst.
assert (stpd2 false G1 (open (varH 0) T0) G3 T3
[(0, (G1, open (varH 0) T0))]) as A. {
simpl in H5. simpl in H9.
eapply stpd2_trans.
eexists; eauto.
change ([(0, (G1, open (varH 0) T0))]) with ((0, (G1, open (varH 0) T0))::[]).
eapply stpd2_narrow. eexists. eassumption. eexists. eassumption.
}
inversion A.
eexists. eapply stp2_bind1; try eassumption.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "bind1". subst.
assert (stpd2 false G1 (open (varH (length ([]:aenv))) T0) G3 T3
[(0, (G1, open (varH (length ([]:aenv))) T0))]) as A. {
eapply stpd2_trans. eauto. eapply stpd2_extendH_mult0.
eapply sstpd2_downgrade. eexists. eauto.
}
destruct A as [? A].
eapply stp2_reg2 in H1. ev.
eexists. eapply stp2_bind1. eauto. eapply stp2_closed. eauto.
eapply stp2_wrapf. apply H1. apply A.
- Case "and11". subst.
eapply IHn in H2. destruct H2 as [? H2].
eexists. eapply stp2_and11.
eassumption. eassumption. omega. eexists. eassumption.
- Case "and12". subst.
eapply IHn in H2. destruct H2 as [? H2].
eexists. eapply stp2_and12.
eassumption. eassumption. omega. eexists. eassumption.
- Case "and2". subst. inversion H1; subst.
+ SCase "top". eapply stp2_reg1 in H. inversion H. eexists. eapply stp2_top; eassumption.
+ SCase "sel2".
assert (sstpd2 false GX' TX' G1 (TMem l T1 TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and11". subst. eapply IHn. apply H2. omega. eexists. eassumption.
+ SCase "and12". subst. eapply IHn. apply H3. omega. eexists. eassumption.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst. eexists. eapply stp2_or21; eauto.
+ SCase "or22". subst. eexists. eapply stp2_or22; eauto.
- Case "or21". subst. inversion H1; subst.
+ SCase "top". eapply stp2_reg1 in H. inversion H. eexists. eapply stp2_top; eassumption.
+ SCase "sel2".
assert (sstpd2 false GX' TX' G1 (TMem l T1 TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst.
assert (sstpd2 false G1 T1 G3 T2 []) as A. {
eapply sstpd2_trans_axiom.
eexists. eapply stp2_wrapf. eapply H.
eexists. eassumption.
}
destruct A as [? A].
eexists. eapply stp2_or21. eapply A. eassumption.
+ SCase "or22". subst.
assert (sstpd2 false G1 T1 G3 T5 []) as A. {
eapply sstpd2_trans_axiom.
eexists. eapply stp2_wrapf. eapply H.
eexists. eassumption.
}
destruct A as [? A].
eexists. eapply stp2_or22. eapply A. eassumption.
+ SCase "or1". subst. eapply IHn. apply H2. omega. eexists. eassumption.
- Case "or22". subst. inversion H1; subst.
+ SCase "top". eapply stp2_reg1 in H. inversion H. eexists. eapply stp2_top; eassumption.
+ SCase "sel2".
assert (sstpd2 false GX' TX' G1 (TMem l T1 TTop) []) as A. {
eapply sstpd2_trans_axiom. eexists. eassumption.
eexists. eapply stp2_wrapf. eapply stp2_mem.
eapply stp2_wrapf. eassumption.
eapply stp2_topx.
}
destruct A as [? A].
eexists. eapply stp2_strong_sel2; eauto.
+ SCase "and2". subst. eexists. eapply stp2_and2; eauto.
+ SCase "or21". subst.
assert (sstpd2 false G1 T1 G3 T2 []) as A. {
eapply sstpd2_trans_axiom.
eexists. eapply stp2_wrapf. eapply H.
eexists. eassumption.
}
destruct A as [? A].
eexists. eapply stp2_or21. eapply A. eassumption.
+ SCase "or22". subst.
assert (sstpd2 false G1 T1 G3 T5 []) as A. {
eapply sstpd2_trans_axiom.
eexists. eapply stp2_wrapf. eapply H.
eexists. eassumption.
}
destruct A as [? A].
eexists. eapply stp2_or22. eapply A. eassumption.
+ SCase "or1". subst. eapply IHn. apply H2. omega. eexists. eassumption.
- Case "or1". subst.
eapply IHn in H2. destruct H2 as [? H2].
eapply IHn in H3. destruct H3 as [? H3].
eexists. eapply stp2_or1.
eassumption. eassumption. omega. eexists. eassumption. omega. eexists. eassumption.
- Case "wrapf". subst. eapply IHn. eapply H2. omega. eexists. eauto.
- Case "transf". subst. eapply IHn. eapply H2. omega. eapply IHn. eapply H3. omega. eexists. eauto.
Grab Existential Variables.
apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0.
apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0. apply 0.
apply 0. apply 0. apply 0. apply 0. apply 0.
Qed.
Lemma sstpd2_trans: forall G1 G2 G3 T1 T2 T3,
sstpd2 true G1 T1 G2 T2 nil ->
sstpd2 true G2 T2 G3 T3 nil ->
sstpd2 true G1 T1 G3 T3 nil.
Proof. intros. repeat eu. eapply sstpd2_trans_aux; eauto. eexists. eauto. Qed.
Lemma sstpd2_untrans_aux: forall n, forall G1 G2 T1 T2 n1,
stp2 0 false G1 T1 G2 T2 nil n1 -> n1 < n ->
sstpd2 true G1 T1 G2 T2 nil.
Proof.
intros n. induction n; intros; try omega.
inversion H; subst.
- Case "wrapf". eexists. eauto.
- Case "transf". eapply sstpd2_trans_aux. eapply H1. eauto. eapply IHn. eauto. omega.
Qed.
Lemma sstpd2_untrans: forall G1 G2 T1 T2,
sstpd2 false G1 T1 G2 T2 nil ->
sstpd2 true G1 T1 G2 T2 nil.
Proof. intros. repeat eu. eapply sstpd2_untrans_aux; eauto. Qed.
Lemma valtp_widen: forall vf H1 H2 T1 T2 n,
val_type H1 vf T1 n ->
sstpd2 true H1 T1 H2 T2 [] ->
val_type H2 vf T2 n.
Proof.
intros. inversion H; econstructor; eauto; eapply sstpd2_trans; eauto.
Qed.
Lemma restp_widen: forall vf H1 H2 T1 T2,
res_type H1 vf T1 ->
sstpd2 true H1 T1 H2 T2 [] ->
res_type H2 vf T2.
Proof.
intros. inversion H. eapply not_stuck. eapply valtp_widen; eauto.
Qed.
Lemma tand_shape: forall T1 T2,
tand T1 T2 = TAnd T1 T2 \/ tand T1 T2 = T1.
Proof.
intros. destruct T2; eauto.
Qed.
Lemma dcs_has_type_shape: forall G f ds T,
dcs_has_type G f ds T ->
T = TTop \/
((exists l T1 T2, T = TAll l T1 T2) \/ (exists l T1, T = TMem l T1 T1)) \/
(exists TA ds' T', T = TAnd TA T' /\
dcs_has_type G f ds' T' /\
((exists l T1 T2, TA = TAll l T1 T2) \/ (exists l T1, TA = TMem l T1 T1))).
Proof.
intros. induction H.
- left. reflexivity.
- destruct IHdcs_has_type; subst.
+ right. left. left. eexists. eexists. eexists.
simpl. reflexivity.
+ right. destruct H4; repeat ev.
* right. destruct H1; repeat ev.
eexists. eexists. eexists.
split. rewrite H1. simpl. reflexivity.
split. eassumption.
left. eexists. eexists. eexists. reflexivity.
eexists. eexists. eexists.
split. rewrite H1. simpl. reflexivity.
split. eassumption.
left. eexists. eexists. eexists. reflexivity.
* right. destruct H3; repeat ev.
eexists. eexists. eexists.
split. rewrite H1. simpl. reflexivity.
split. eassumption.
left. eexists. eexists. eexists. reflexivity.
eexists. eexists. eexists.
split. rewrite H1. simpl. reflexivity.
split. eassumption.
left. eexists. eexists. eexists. reflexivity.
- destruct IHdcs_has_type; subst.
+ right. left. right. eexists. eexists.
simpl. reflexivity.
+ right. destruct H2; repeat ev.
* right. destruct H0; repeat ev.
eexists. eexists. eexists.
split. rewrite H0. simpl. reflexivity.
split. eassumption.
right. eexists. eexists. reflexivity.
eexists. eexists. eexists.
split. rewrite H0. simpl. reflexivity.
split. eassumption.
right. eexists. eexists. reflexivity.
* right. destruct H2; repeat ev.
eexists. eexists. eexists.
split. rewrite H0. simpl. reflexivity.
split. eassumption.
right. eexists. eexists. reflexivity.
eexists. eexists. eexists.
split. rewrite H0. simpl. reflexivity.
split. eassumption.
right. eexists. eexists. reflexivity.
Qed.
Lemma dcs_tbind_aux: forall n, forall G f ds venv1 T x venv0 T0 n0,
n0 <= n ->
dcs_has_type G f ds T ->
stp2 0 true venv1 (open (varF x) T) venv0 (TBind T0) [] n0 ->
False.
Proof.
intros n. induction n.
intros. inversion H1; omega.
intros. eapply dcs_has_type_shape in H0.
destruct H0. subst. inversion H1.
destruct H0.
destruct H0.
repeat ev. subst. inversion H1.
rep