aboutsummaryrefslogtreecommitdiffstats
path: root/cparser/Cutil.ml
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2016-03-15 15:07:47 +0100
committerBernhard Schommer <bernhardschommer@gmail.com>2016-03-15 15:07:47 +0100
commit272a5b812b72f4c3e409ccdbeaf3476d95c4b552 (patch)
tree6a8d5e75a11860b69522cef3b512b1ef5effb438 /cparser/Cutil.ml
parent2185164c1845c30ebd4118ed5bc8d339b16663a9 (diff)
downloadcompcert-kvx-272a5b812b72f4c3e409ccdbeaf3476d95c4b552.tar.gz
compcert-kvx-272a5b812b72f4c3e409ccdbeaf3476d95c4b552.zip
Deactivate warning 27 and added back removed code.
The code was mostly there for documentation effort. So warning 27 is deactivated again. Bug 18349
Diffstat (limited to 'cparser/Cutil.ml')
-rw-r--r--cparser/Cutil.ml56
1 files changed, 28 insertions, 28 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 19f6d29a..1bbb8e98 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -73,7 +73,7 @@ let rec find_custom_attributes (names: string list) (al: attributes) =
let rec remove_custom_attributes (names: string list) (al: attributes) =
match al with
| [] -> []
- | Attr(name, _) :: tl when List.mem name names ->
+ | Attr(name, args) :: tl when List.mem name names ->
remove_custom_attributes names tl
| a :: tl ->
a :: remove_custom_attributes names tl
@@ -137,12 +137,12 @@ let rec unroll env t =
let rec attributes_of_type env t =
match t with
| TVoid a -> a
- | TInt(_, a) -> a
- | TFloat(_, a) -> a
- | TPtr(_, a) -> a
- | TArray(ty, _, a) -> add_attributes a (attributes_of_type env ty)
- | TFun(_, _,_, a) -> a
- | TNamed(_, _) -> attributes_of_type env (unroll env t)
+ | TInt(ik, a) -> a
+ | TFloat(fk, a) -> a
+ | TPtr(ty, a) -> a
+ | TArray(ty, sz, a) -> add_attributes a (attributes_of_type env ty)
+ | TFun(ty, params, vararg, a) -> a
+ | TNamed(s, a) -> attributes_of_type env (unroll env t)
| TStruct(s, a) ->
let ci = Env.find_struct env s in add_attributes ci.ci_attr a
| TUnion(s, a) ->
@@ -162,7 +162,7 @@ let rec change_attributes_type env (f: attributes -> attributes) t =
| TArray(ty, sz, a) ->
TArray(change_attributes_type env f ty, sz, f a)
| TFun(ty, params, vararg, a) -> TFun(ty, params, vararg, f a)
- | TNamed(_, _) ->
+ | TNamed(s, a) ->
let t1 = unroll env t in
let t2 = change_attributes_type env f t1 in
if t2 = t1 then t else t2 (* avoid useless expansion *)
@@ -174,7 +174,7 @@ let remove_attributes_type env attr t =
change_attributes_type env (fun a -> remove_attributes a attr) t
let erase_attributes_type env t =
- change_attributes_type env (fun _ -> []) t
+ change_attributes_type env (fun a -> []) t
(* Remove all attributes from type that are not contained in attr *)
let strip_attributes_type t attr =
@@ -224,7 +224,7 @@ let alignas_attribute al =
let rec alignas_attr accu = function
| [] -> accu
| AAlignas n :: al -> alignas_attr (max n accu) al
- | _ :: al -> alignas_attr accu al
+ | a :: al -> alignas_attr accu al
in alignas_attr 0 al
(* Type compatibility *)
@@ -260,14 +260,14 @@ let combine_types mode env t1 t2 =
| None, _ -> sz2
| _, None -> sz1
| Some n1, Some n2 -> if n1 = n2 then Some n2 else raise Incompat
- and comp_conv (_, ty) =
+ and comp_conv (id, ty) =
match unroll env ty with
- | TInt(kind, _) ->
+ | TInt(kind, attr) ->
begin match kind with
| IBool | IChar | ISChar | IUChar | IShort | IUShort -> raise Incompat
| _ -> ()
end
- | TFloat(kind, _) ->
+ | TFloat(kind, attr) ->
begin match kind with
| FFloat -> raise Incompat
| _ -> ()
@@ -295,7 +295,7 @@ let combine_types mode env t1 t2 =
| Some l1, None -> List.iter comp_conv l1; (params1, vararg1)
| Some l1, Some l2 ->
if List.length l1 <> List.length l2 then raise Incompat;
- let comp_param (_, ty1) (id2, ty2) =
+ let comp_param (id1, ty1) (id2, ty2) =
(id2, comp AttrIgnoreTop ty1 ty2) in
(Some(List.map2 comp_param l1 l2), comp_base vararg1 vararg2)
in
@@ -309,8 +309,8 @@ let combine_types mode env t1 t2 =
TUnion(comp_base s1 s2, comp_attr m a1 a2)
| TEnum(s1, a1), TEnum(s2, a2) ->
TEnum(comp_base s1 s2, comp_attr m a1 a2)
- | TEnum(s,a1), TInt(_,a2)
- | TInt(_,a2), TEnum (s,a1) ->
+ | TEnum(s,a1), TInt(enum_ikind,a2)
+ | TInt(enum_ikind,a2), TEnum (s,a1) ->
TEnum(s,comp_attr m a1 a2)
| _, _ ->
raise Incompat
@@ -432,7 +432,7 @@ let alignof_struct_union env members =
| None -> None
| Some a -> align_rec (max a al) rem
end else begin
- let (_, a, ml') = pack_bitfields ml in
+ let (s, a, ml') = pack_bitfields ml in
align_rec (max a al) ml'
end
in align_rec 1 members
@@ -471,7 +471,7 @@ let rec sizeof env t =
| TInt(ik, _) -> Some(sizeof_ikind ik)
| TFloat(fk, _) -> Some(sizeof_fkind fk)
| TPtr(_, _) -> Some(!config.sizeof_ptr)
- | TArray(_, None, _) -> None
+ | TArray(ty, None, _) -> None
| TArray(ty, Some n, _) as t' ->
begin match sizeof env ty with
| None -> None
@@ -721,7 +721,7 @@ let pointer_decay env t =
let unary_conversion env t =
match unroll env t with
(* Promotion of small integer types *)
- | TInt(kind, _) ->
+ | TInt(kind, attr) ->
begin match kind with
| IBool | IChar | ISChar | IUChar | IShort | IUShort ->
TInt(IInt, [])
@@ -729,13 +729,13 @@ let unary_conversion env t =
TInt(kind, [])
end
(* Enums are like signed ints *)
- | TEnum(_, _) -> TInt(enum_ikind, [])
+ | TEnum(id, attr) -> TInt(enum_ikind, [])
(* Arrays and functions decay automatically to pointers *)
| TArray(ty, _, _) -> TPtr(ty, [])
| TFun _ as ty -> TPtr(ty, [])
(* Float types and pointer types lose their attributes *)
- | TFloat(kind, _) -> TFloat(kind, [])
- | TPtr(ty, _) -> TPtr(ty, [])
+ | TFloat(kind, attr) -> TFloat(kind, [])
+ | TPtr(ty, attr) -> TPtr(ty, [])
(* Other types should not occur, but in doubt... *)
| _ -> t
@@ -859,7 +859,7 @@ let type_of_constant = function
let rec is_lvalue e =
match e.edesc with
- | EVar _ -> true
+ | EVar id -> true
| EUnop((Oderef | Oarrow _), _) -> true
| EUnop(Odot _, e') -> is_lvalue e'
| EBinop(Oindex, _, _, _) -> true
@@ -905,8 +905,8 @@ let is_debug_stmt s =
Custom attributes can safely be dropped or added. *)
let valid_assignment_attr afrom ato =
- let (afromstd, _) = List.partition attr_is_standard afrom
- and (atostd,_) = List.partition attr_is_standard ato in
+ let (afromstd, afromcustom) = List.partition attr_is_standard afrom
+ and (atostd, atocustom) = List.partition attr_is_standard ato in
incl_attributes afromstd atostd
(* Check that an assignment is allowed *)
@@ -1031,11 +1031,11 @@ let rec default_init env ty =
match unroll env ty with
| TInt _ | TEnum _ ->
Init_single (intconst 0L IInt)
- | TFloat(_, _) ->
+ | TFloat(fk, _) ->
Init_single floatconst0
- | TPtr(_, _) ->
+ | TPtr(ty, _) ->
Init_single nullconst
- | TArray(_, _, _) ->
+ | TArray(ty, sz, _) ->
Init_array []
| TStruct(id, _) ->
let rec default_init_fields = function