Section SOUNDNESS_CONSTRUCTORS.
Variable ce: composite_env.
Variable e: typenv.
Variable rt: type.
Hint Resolve check_rval_wt check_lval_wt: ty.
Hint Extern 1 (wt_expr _ _ _) => (unfold wt_expr; simpl): ty.
End SOUNDNESS_CONSTRUCTORS.
(** * Subject reduction *)
(** We show that reductions preserve well-typedness *)
Proof with (try discriminate).
intros. unfold sem_binarith, binarith_type in *.
set (ty' := Cop.binarith_type (classify_binarith ty1 ty2)) in *.
destruct (sem_cast v1 ty1 ty' m) as [v1'|] eqn:CAST1...
destruct (sem_cast v2 ty2 ty' m) as [v2'|] eqn:CAST2...
DestructCases.
- specialize (H s i i0). rewrite H3 in H.
destruct v; auto with ty; contradiction.
- specialize (H0 s i i0). rewrite H3 in H0.
destruct v; auto with ty; contradiction.
- specialize (H1 f f0). rewrite H3 in H1.
destruct v; auto with ty; contradiction.
- specialize (H2 f f0). rewrite H3 in H2.
destruct v; auto with ty; contradiction.
Qed.
Proof with (try discriminate).
unfold comparison_type, sem_cmp; intros.
assert (X: forall b, wt_val (Val.of_bool b) (Tint I32 Signed noattr)).
{
intros b; destruct b; constructor; exact I.
}
assert (Y: forall ob, option_map Val.of_bool ob = Some v -> wt_val v (Tint I32 Signed noattr)).
{
intros ob EQ. destruct ob as [b|]; inv EQ. eauto.
}
destruct (classify_cmp ty1 ty2).
- inv H; eauto.
- DestructCases; eauto.
- DestructCases; eauto.
- DestructCases; eauto.
- DestructCases; eauto.
- unfold sem_binarith in H0.
set (ty' := Cop.binarith_type (classify_binarith ty1 ty2)) in *.
destruct (sem_cast v1 ty1 ty') as [v1'|]...
destruct (sem_cast v2 ty2 ty') as [v2'|]...
DestructCases; auto.
Qed.

Lemma pres_sem_binop:
forall ce op ty1 ty2 ty v1 v2 v m,
type_binop op ty1 ty2 = OK ty ->
sem_binary_operation ce op v1 ty1 v2 ty2 m = Some v ->
wt_val v1 ty1 -> wt_val v2 ty2 ->
wt_val v ty.