Definition denote_tc_assert' {CS: compspecs} (a: tc_assert) (rho: environ) : mpred.
pose (P := denote_tc_assert a rho).
unfold denote_tc_assert in P.
super_unfold_lift.
destruct a; apply P.
Defined.
Definition check_pp_int' e1 e2 op t e :=
match op with
| Cop.Oeq | Cop.One =>
tc_andp'
(tc_test_eq' e1 e2)
(tc_bool (is_int_type t) (op_result_type e))
| Cop.Ole | Cop.Olt | Cop.Oge | Cop.Ogt =>
tc_andp'
(tc_test_order' e1 e2)
(tc_bool (is_int_type t) (op_result_type e))
| _ => tc_noproof
end.
(* Definition check_pl_long' e2 op t e := match op with | Cop.Oeq | Cop.One => tc_andp' (tc_iszero' e2) (tc_bool (is_int_type t) (op_result_type e)) | _ => tc_noproof end. *)
Hint Rewrite @denote_tc_assert_andp' @denote_tc_assert_andp''
@denote_tc_assert_orp' @denote_tc_assert_orp''
@denote_tc_assert_iszero' @denote_tc_assert_nonzero'
@denote_tc_assert_nodivover' @denote_tc_assert_ilt' @denote_tc_assert_llt'
@denote_tc_assert_test_eq' @denote_tc_assert_test_order'
: dtca.
Ltac dtca := autorewrite with dtca; auto.
Definition stupid_typeconv ty :=
match ty with
| Tarray t _ a => Tpointer t a
| Tfunction _ _ _ => Tpointer ty noattr
| Tint _ _ _ => typeconv ty
| _ => ty
end.
Definition classify_sub' ty1 ty2 :=
match stupid_typeconv ty1 with
| Tpointer ty a =>
match stupid_typeconv ty2 with
| Tint _ si _ => sub_case_pi ty si
| Tlong _ _ => sub_case_pl ty
| Tpointer _ _ => sub_case_pp ty
| _ => sub_default
end
| _ => sub_default
end.
Definition classify_cmp' ty1 ty2 :=
match stupid_typeconv ty1, stupid_typeconv ty2 with
| Tpointer _ _ , Tpointer _ _ => cmp_case_pp
| Tpointer _ _ , Tint _ si _ => cmp_case_pi si
| Tint _ si _, Tpointer _ _ => cmp_case_ip si
| Tpointer _ _ , Tlong _ _ => cmp_case_pl
| Tlong _ _ , Tpointer _ _ => cmp_case_lp
| _, _ => cmp_default
end.
Definition classify_add' ty1 ty2 :=
match stupid_typeconv ty1 with
| Tint _ si _ =>
match stupid_typeconv ty2 with
| Tpointer ty a => add_case_ip si ty
|  _ => add_default
end
| Tlong _ _ =>
match stupid_typeconv ty2 with
| Tpointer ty a => add_case_lp ty
| _ => add_default
end
| Tpointer ty a =>
match stupid_typeconv ty2 with
| Tint _ si _ => add_case_pi ty si
| Tlong _ _ => add_case_pl ty
| _ => add_default
end
| _ => add_default
end.
Definition classify_shift' (ty1: type) (ty2: type) :=
match stupid_typeconv ty1, stupid_typeconv ty2 with
| Tint sz sg _, Tint _ _ _ => shift_case_ii
match sz, sg with
| I32, Unsigned => Unsigned
| _, _ => Signed
end
| Tint sz sg _, Tlong _ _ => shift_case_il
match sz, sg with
| I32, Unsigned => Unsigned
| _, _ => Signed
end
| Tlong s _, Tint _ _ _ => shift_case_li s
| Tlong s _, Tlong _ _ => shift_case_ll s
| _,_  => shift_default
end.
Definition classify_binarith' (ty1: type) (ty2: type) :=
match stupid_typeconv ty1, stupid_typeconv ty2 with
| Tint i1 s1 _, Tint i2 s2 _ => bin_case_i
match i1, s1, i2, s2 with
| I32, Unsigned, _, _ => Unsigned
| _, _, I32, Unsigned => Unsigned
| _, _, _, _ => Signed
end
| Tint _ _ _, Tlong s _ => bin_case_l s
| Tlong s _, Tint _ _ _ => bin_case_l s
| Tlong s1 _, Tlong s2 _ => bin_case_l
match s1, s2 with
| Signed, Signed => Signed
| _, _ => Unsigned
end
| Tfloat F32 _, Tfloat F32 _ => bin_case_s
| Tfloat _ _, Tfloat _ _ => bin_case_f
| Tfloat F64 _, (Tint _ _ _ | Tlong _ _) => bin_case_f
| (Tint _ _ _ | Tlong _ _), Tfloat F64 _ => bin_case_f
| Tfloat F32 _, (Tint _ _ _ | Tlong _ _) => bin_case_s
| (Tint _ _ _ | Tlong _ _), Tfloat F32 _ => bin_case_s
| _, _ => bin_default
end.
Definition binarithType' t1 t2 ty deferr reterr : tc_assert :=
match classify_binarith' t1 t2 with
| Cop.bin_case_i sg =>  tc_bool (is_int32_type ty) reterr
| Cop.bin_case_l sg => tc_bool (is_long_type ty) reterr
| Cop.bin_case_f   => tc_bool (is_float_type ty) reterr
| Cop.bin_case_s   => tc_bool (is_single_type ty) reterr
| Cop.bin_default => tc_FF deferr
end.

Lemma den_isBinOpR: forall {CS: compspecs} op a1 a2 ty,
denote_tc_assert (isBinOpResultType op a1 a2 ty) =
let e := (Ebinop op a1 a2 ty) in
let reterr := op_result_type e in
let deferr := arg_type e in
denote_tc_assert
match op with
| Cop.Oadd => match classify_add' (typeof a1) (typeof a2) with
| Cop.add_case_pi t _ => tc_andp' (tc_andp' (tc_andp' (tc_isptr a1)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a1)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.add_case_ip _ t => tc_andp' (tc_andp' (tc_andp' (tc_isptr a2)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a2)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.add_case_pl t => tc_andp' (tc_andp' (tc_andp' (tc_isptr a1)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a1)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.add_case_lp t => tc_andp' (tc_andp' (tc_andp' (tc_isptr a2)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a2)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.add_default => tc_andp
(binarithType' (typeof a1) (typeof a2) ty deferr reterr)
(tc_nobinover Z.add a1 a2)
end
| Cop.Osub => match classify_sub' (typeof a1) (typeof a2) with
| Cop.sub_case_pi t _ => tc_andp' (tc_andp' (tc_andp' (tc_isptr a1)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a1)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.sub_case_pl t => tc_andp' (tc_andp' (tc_andp' (tc_isptr a1)
(tc_bool (complete_type cenv_cs t) reterr))
(tc_int_or_ptr_type (typeof a1)))
(tc_bool (is_pointer_type ty) reterr)
| Cop.sub_case_pp t =>
tc_andp' (tc_andp' (tc_andp' (tc_andp' (tc_andp' (tc_andp'
(tc_andp' (tc_andp' (tc_samebase a1 a2)
(tc_isptr a1))
(tc_isptr a2))
(tc_int_or_ptr_type (typeof a1)))
(tc_int_or_ptr_type (typeof a2)))
(tc_bool (is_ptrofs_type ty) reterr))
(tc_bool (negb (Z.eqb (sizeof t) 0))
(pp_compare_size_0 t)))
(tc_bool (complete_type cenv_cs t) reterr))
(tc_bool (Z.leb (sizeof t) Ptrofs.max_signed)
(pp_compare_size_exceed t))
| Cop.sub_default => tc_andp
(binarithType' (typeof a1) (typeof a2) ty deferr reterr)
(tc_nobinover Z.sub a1 a2)
end
| Cop.Omul => tc_andp (binarithType' (typeof a1) (typeof a2) ty deferr reterr)
(tc_nobinover Z.mul a1 a2)
| Cop.Omod => match classify_binarith' (typeof a1) (typeof a2) with
| Cop.bin_case_i Unsigned =>
tc_andp' (tc_nonzero' a2)
(tc_bool (is_int32_type ty) reterr)
| Cop.bin_case_l Unsigned =>
tc_andp' (tc_nonzero' a2)
(tc_bool (is_long_type ty) reterr)
| Cop.bin_case_i Signed => tc_andp' (tc_andp' (tc_nonzero' a2)
(tc_nodivover' a1 a2))
(tc_bool (is_int32_type ty) reterr)
| Cop.bin_case_l Signed => tc_andp' (tc_andp' (tc_nonzero' a2)
(tc_nodivover' a1 a2))
(tc_bool (is_long_type ty) reterr)
| _ => tc_FF deferr
end
| Cop.Odiv => match classify_binarith' (typeof a1) (typeof a2) with
| Cop.bin_case_i Unsigned => tc_andp' (tc_nonzero' a2) (tc_bool (is_int32_type ty) reterr)
| Cop.bin_case_l Unsigned => tc_andp' (tc_nonzero' a2) (tc_bool (is_long_type ty) reterr)
| Cop.bin_case_i Signed => tc_andp' (tc_andp' (tc_nonzero' a2) (tc_nodivover' a1 a2))
(tc_bool (is_int32_type ty) reterr)
| Cop.bin_case_l Signed => tc_andp' (tc_andp' (tc_nonzero' a2) (tc_nodivover' a1 a2))
(tc_bool (is_long_type ty) reterr)
| Cop.bin_case_f  =>  tc_bool (is_float_type ty) reterr
| Cop.bin_case_s  =>  tc_bool (is_single_type ty) reterr
| Cop.bin_default => tc_FF deferr
end
| Cop.Oshl | Cop.Oshr => match classify_shift' (typeof a1) (typeof a2) with
| Cop.shift_case_ii _ =>  tc_andp' (tc_ilt' a2 Int.iwordsize) (tc_bool (is_int32_type ty)
reterr)
| Cop.shift_case_il _ =>  tc_andp' (tc_llt' a2 (Int64.repr 32)) (tc_bool (is_int32_type ty)
reterr)
| Cop.shift_case_li _ =>  tc_andp' (tc_ilt' a2 Int64.iwordsize') (tc_bool (is_long_type ty)
reterr)
| Cop.shift_case_ll _ =>  tc_andp' (tc_llt' a2 Int64.iwordsize) (tc_bool (is_long_type ty)
reterr)
| _ => tc_FF deferr
end
| Cop.Oand | Cop.Oor | Cop.Oxor =>
match classify_binarith' (typeof a1) (typeof a2) with
| Cop.bin_case_i _ =>tc_bool (is_int32_type ty) reterr
| Cop.bin_case_l _ =>tc_bool (is_long_type ty) reterr
| Cop.bin_case_f => tc_FF deferr
| Cop.bin_case_s => tc_FF deferr
| Cop.bin_default => tc_FF deferr
end
| Cop.Oeq | Cop.One | Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge =>
match classify_cmp' (typeof a1) (typeof a2) with
| Cop.cmp_default =>
tc_bool (is_numeric_type (typeof a1)
&& is_numeric_type (typeof a2)
&& is_int_type ty)
deferr
| Cop.cmp_case_pp => tc_andp' (tc_andp' (tc_int_or_ptr_type (typeof a1))
(tc_int_or_ptr_type (typeof a2)))
(check_pp_int' a1 a2 op ty e)
| Cop.cmp_case_pi si =>
tc_andp' (tc_int_or_ptr_type (typeof a1))
(check_pp_int' a1 (Ecast a2 size_t) op ty e)
| Cop.cmp_case_ip si =>
tc_andp' (tc_int_or_ptr_type (typeof a2))
(check_pp_int' (Ecast a1 size_t) a2 op ty e)
| Cop.cmp_case_pl =>
tc_andp' (tc_int_or_ptr_type (typeof a1))
(check_pp_int' a1 (Ecast a2 size_t) op ty e)
| Cop.cmp_case_lp =>
tc_andp' (tc_int_or_ptr_type (typeof a2))
(check_pp_int' (Ecast a1 size_t) a2 op ty e)
end
end.