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.

Theorem type_function_sound: forall f env,
type_function f = OK env -> wt_function env f.