Section SPEC.
Variable env: ident -> typ.
Variable tret: rettype.
Inductive wt_expr: expr -> typ -> Prop :=
| wt_Evar: forall id,
wt_expr (Evar id) (env id)
| wt_Econst: forall c,
wt_expr (Econst c) (type_constant c)
| wt_Eunop: forall op a1 targ1 tres,
type_unop op = (targ1, tres) ->
wt_expr a1 targ1 ->
wt_expr (Eunop op a1) tres
| wt_Ebinop: forall op a1 a2 targ1 targ2 tres,
type_binop op = (targ1, targ2, tres) ->
wt_expr a1 targ1 -> wt_expr a2 targ2 ->
wt_expr (Ebinop op a1 a2) tres
| wt_Eload: forall chunk a1,
wt_expr a1 Tptr ->
wt_expr (Eload chunk a1) (type_of_chunk chunk).
Definition wt_opt_assign (optid: option ident) (ty: rettype) : Prop :=
match optid with
| Some id => proj_rettype ty = env id
| _ => True
end.
Inductive wt_stmt: stmt -> Prop :=
| wt_Sskip:
wt_stmt Sskip
| wt_Sassign: forall id a,
wt_expr a (env id) ->
wt_stmt (Sassign id a)
| wt_Sstore: forall chunk a1 a2,
wt_expr a1 Tptr -> wt_expr a2 (type_of_chunk chunk) ->
wt_stmt (Sstore chunk a1 a2)
| wt_Scall: forall optid sg a1 al,
wt_expr a1 Tptr -> list_forall2 wt_expr al sg.(sig_args) ->
wt_opt_assign optid sg.(sig_res) ->
wt_stmt (Scall optid sg a1 al)
| wt_Stailcall: forall sg a1 al,
wt_expr a1 Tptr -> list_forall2 wt_expr al sg.(sig_args) ->
sg.(sig_res) = tret ->
wt_stmt (Stailcall sg a1 al)
| wt_Sbuiltin: forall optid ef al,
list_forall2 wt_expr al (ef_sig ef).(sig_args) ->
wt_opt_assign optid (ef_sig ef).(sig_res) ->
wt_stmt (Sbuiltin optid ef al)
| wt_Sseq: forall s1 s2,
wt_stmt s1 -> wt_stmt s2 ->
wt_stmt (Sseq s1 s2)
| wt_Sifthenelse: forall a s1 s2,
wt_expr a Tint -> wt_stmt s1 -> wt_stmt s2 ->
wt_stmt (Sifthenelse a s1 s2)
| wt_Sloop: forall s1,
wt_stmt s1 ->
wt_stmt (Sloop s1)
| wt_Sblock: forall s1,
wt_stmt s1 ->
wt_stmt (Sblock s1)
| wt_Sexit: forall n,
wt_stmt (Sexit n)
| wt_Sswitch: forall (sz: bool) a tbl dfl,
wt_expr a (if sz then Tlong else Tint) ->
wt_stmt (Sswitch sz a tbl dfl)
| wt_Sreturn_none:
wt_stmt (Sreturn None)
| wt_Sreturn_some: forall a,
wt_expr a (proj_rettype tret) ->
wt_stmt (Sreturn (Some a))
| wt_Slabel: forall lbl s1,
wt_stmt s1 ->
wt_stmt (Slabel lbl s1)
| wt_Sgoto: forall lbl,
wt_stmt (Sgoto lbl).
End SPEC.
Inductive wt_function (env: typenv) (f: function) : Prop :=
wt_function_intro:
type_function f = OK env ->     (**r to ensure uniqueness of [env] *)
List.map env f.(fn_params) = f.(fn_sig).(sig_args) ->
wt_stmt env f.(fn_sig).(sig_res) f.(fn_body) ->
wt_function env f.
Inductive wt_fundef: fundef -> Prop :=
| wt_fundef_internal: forall env f,
wt_function env f ->
wt_fundef (Internal f)
| wt_fundef_external: forall ef,
wt_fundef (External ef).
Definition wt_program (p: program): Prop :=
forall i f, In (i, Gfun f) (prog_defs p) -> wt_fundef f.
(** * Soundness of type inference *)
Hint Resolve expect_incr: ty.
Hint Resolve type_expr_incr: ty.
Hint Resolve type_exprlist_incr: ty.
Hint Resolve type_assign_incr: ty.
Hint Resolve opt_set_incr: ty.
Hint Resolve type_stmt_incr: ty.
(** * Semantic soundness of the type system *)
Definition wt_env (env: typenv) (e: Cminor.env) : Prop :=
forall id v, e!id = Some v -> Val.has_type v (env id).
Definition def_env (f: function) (e: Cminor.env) : Prop :=
forall id, In id f.(fn_params) \/ In id f.(fn_vars) -> exists v, e!id = Some v.
Inductive wt_cont_call: cont -> rettype -> Prop :=
| wt_cont_Kstop:
wt_cont_call Kstop Tint
| wt_cont_Kcall: forall optid f sp e k tret env
(WT_FN: wt_function env f)
(WT_CONT: wt_cont env f.(fn_sig).(sig_res) k)
(WT_ENV: wt_env env e)
(DEF_ENV: def_env f e)
(WT_DEST: wt_opt_assign env optid tret),
wt_cont_call (Kcall optid f sp e k) tret
with wt_cont: typenv -> rettype -> cont -> Prop :=
| wt_cont_Kseq: forall env tret s k,
wt_stmt env tret s ->
wt_cont env tret k ->
wt_cont env tret (Kseq s k)
| wt_cont_Kblock: forall env tret k,
wt_cont env tret k ->
wt_cont env tret (Kblock k)
| wt_cont_other: forall env tret k,
wt_cont_call k tret ->
wt_cont env tret k.
Inductive wt_state: state -> Prop :=
| wt_normal_state: forall f s k sp e m env
(WT_FN: wt_function env f)
(WT_STMT: wt_stmt env f.(fn_sig).(sig_res) s)
(WT_CONT: wt_cont env f.(fn_sig).(sig_res) k)
(WT_ENV: wt_env env e)
(DEF_ENV: def_env f e),
wt_state (State f s k sp e m)
| wt_call_state: forall f args k m
(WT_FD: wt_fundef f)
(WT_ARGS: Val.has_type_list args (funsig f).(sig_args))
(WT_CONT: wt_cont_call k (funsig f).(sig_res)),
wt_state (Callstate f args k m)
| wt_return_state: forall v k m tret
(WT_RES: Val.has_type v (proj_rettype tret))
(WT_CONT: wt_cont_call k tret),
wt_state (Returnstate v k m).

Lemma wt_find_label: forall env tret lbl s k,
wt_stmt env tret s -> wt_cont env tret k ->
match find_label lbl s k with
| Some (s', k') => wt_stmt env tret s' /\ wt_cont env tret k'
| None => True
end.