summaryrefslogtreecommitdiff
path: root/cparser/Elab.ml
diff options
context:
space:
mode:
authorGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2014-04-23 09:18:51 +0000
committerGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2014-04-23 09:18:51 +0000
commit2f643e4419e8237c63d6823720da8100da9c8b11 (patch)
tree8a243fe800541597beffe8fec152f20d6bada549 /cparser/Elab.ml
parent214ab56c02860a9c472f701b601cbf6c9cf5fd69 (diff)
Clean-up pass on C types:
- Ctypes: add useful functions on attributes; remove attrs in typeconv (because attributes are meaningless on r-values) - C2C: fixed missing or redundant Evalof - Cop: ignore attributes in ptr + int and ptr - int (meaningless on r-values); add sanity check between typeconv/classify_binarith and the C99 standard. - cparser: fixed several cases where incorrect type annotations were put on expressions. git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2457 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'cparser/Elab.ml')
-rw-r--r--cparser/Elab.ml26
1 files changed, 14 insertions, 12 deletions
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index 0d2cb89..ecc97a7 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -805,7 +805,8 @@ let elab_expr loc env a =
error "left-hand side of '.' is not a struct or union" in
(* A field of a const/volatile struct or union is itself const/volatile *)
{ edesc = EUnop(Odot fieldname, b1);
- etyp = add_attributes_type attrs (type_of_member env fld) }
+ etyp = add_attributes_type (List.filter attr_inherited_by_members attrs)
+ (type_of_member env fld) }
| MEMBEROFPTR(a1, fieldname) ->
let b1 = elab a1 in
@@ -823,7 +824,8 @@ let elab_expr loc env a =
| _ ->
error "left-hand side of '->' is not a pointer " in
{ edesc = EUnop(Oarrow fieldname, b1);
- etyp = add_attributes_type attrs (type_of_member env fld) }
+ etyp = add_attributes_type (List.filter attr_inherited_by_members attrs)
+ (type_of_member env fld) }
(* Hack to treat vararg.h functions the GCC way. Helps with testing.
va_start(ap,n)
@@ -996,14 +998,14 @@ let elab_expr loc env a =
if is_arith_type env b1.etyp && is_arith_type env b2.etyp then
binary_conversion env b1.etyp b2.etyp
else begin
- let (ty, attr) =
+ let ty =
match unroll env b1.etyp, unroll env b2.etyp with
- | (TPtr(ty, a) | TArray(ty, _, a)), (TInt _ | TEnum _) -> (ty, a)
- | (TInt _ | TEnum _), (TPtr(ty, a) | TArray(ty, _, a)) -> (ty, a)
+ | (TPtr(ty, a) | TArray(ty, _, a)), (TInt _ | TEnum _) -> ty
+ | (TInt _ | TEnum _), (TPtr(ty, a) | TArray(ty, _, a)) -> ty
| _, _ -> error "type error in binary '+'" in
if not (pointer_arithmetic_ok env ty) then
err "illegal pointer arithmetic in binary '+'";
- TPtr(ty, attr)
+ TPtr(ty, [])
end in
{ edesc = EBinop(Oadd, b1, b2, tyres); etyp = tyres }
@@ -1019,11 +1021,11 @@ let elab_expr loc env a =
| (TPtr(ty, a) | TArray(ty, _, a)), (TInt _ | TEnum _) ->
if not (pointer_arithmetic_ok env ty) then
err "illegal pointer arithmetic in binary '-'";
- (TPtr(ty, a), TPtr(ty, a))
+ (TPtr(ty, []), TPtr(ty, []))
| (TInt _ | TEnum _), (TPtr(ty, a) | TArray(ty, _, a)) ->
if not (pointer_arithmetic_ok env ty) then
err "illegal pointer arithmetic in binary '-'";
- (TPtr(ty, a), TPtr(ty, a))
+ (TPtr(ty, []), TPtr(ty, []))
| (TPtr(ty1, a1) | TArray(ty1, _, a1)),
(TPtr(ty2, a2) | TArray(ty2, _, a2)) ->
if not (compatible_types ~noattrs:true env ty1 ty2) then
@@ -1084,7 +1086,7 @@ let elab_expr loc env a =
| TPtr(ty1, a1), TPtr(ty2, a2) ->
let tyres =
if is_void_type env ty1 || is_void_type env ty2 then
- TPtr(TVoid [], add_attributes a1 a2)
+ TPtr(TVoid (add_attributes a1 a2), [])
else
match combine_types ~noattrs:true env
(TPtr(ty1, a1)) (TPtr(ty2, a2)) with
@@ -1095,9 +1097,9 @@ let elab_expr loc env a =
in
{ edesc = EConditional(b1, b2, b3); etyp = tyres }
| TPtr(ty1, a1), TInt _ when is_literal_0 b3 ->
- { edesc = EConditional(b1, b2, nullconst); etyp = TPtr(ty1, a1) }
+ { edesc = EConditional(b1, b2, nullconst); etyp = TPtr(ty1, []) }
| TInt _, TPtr(ty2, a2) when is_literal_0 b2 ->
- { edesc = EConditional(b1, nullconst, b3); etyp = TPtr(ty2, a2) }
+ { edesc = EConditional(b1, nullconst, b3); etyp = TPtr(ty2, []) }
| ty1, ty2 ->
match combine_types ~noattrs:true env ty1 ty2 with
| None ->
@@ -1312,7 +1314,7 @@ let init_char_array_string opt_size s =
if i < 0L then init else begin
let c =
if i < len then Int64.of_int (Char.code s.[Int64.to_int i]) else 0L in
- add_chars (Int64.pred i) (Init_single (intconst c IChar) :: init)
+ add_chars (Int64.pred i) (Init_single (intconst c IInt) :: init)
end in
Init_array (add_chars (Int64.pred size) [])