aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2015-10-12 16:58:23 +0200
committerBernhard Schommer <bernhardschommer@gmail.com>2015-10-12 17:18:07 +0200
commit906873ee165cbaabf36ca51792eb5a498a12bd72 (patch)
treef32bcee6d0fc0d3039c57267b8b4d8db847ad9d9
parenta68c024bd8421cda0d21802669cb01730d109378 (diff)
downloadcompcert-kvx-906873ee165cbaabf36ca51792eb5a498a12bd72.tar.gz
compcert-kvx-906873ee165cbaabf36ca51792eb5a498a12bd72.zip
Move strip functions to Cutil.
Since the strip functions might be useful in other context and is more general then the debug information. Bug 17392.
-rw-r--r--cparser/Cutil.ml42
-rw-r--r--cparser/Cutil.mli4
-rw-r--r--debug/DebugInformation.ml42
3 files changed, 47 insertions, 41 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 0def347f..60bcc1a7 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -177,6 +177,48 @@ let remove_attributes_type env attr t =
let erase_attributes_type env 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 =
+ let strip = List.filter (fun a -> List.mem a attr) in
+ match t with
+ | TVoid at -> TVoid (strip at)
+ | TInt (k,at) -> TInt (k,strip at)
+ | TFloat (k,at) -> TFloat(k,strip at)
+ | TPtr (t,at) -> TPtr(t,strip at)
+ | TArray (t,s,at) -> TArray(t,s,strip at)
+ | TFun (t,arg,v,at) -> TFun(t,arg,v,strip at)
+ | TNamed (n,at) -> TNamed(n,strip at)
+ | TStruct (n,at) -> TStruct(n,strip at)
+ | TUnion (n,at) -> TUnion(n,strip at)
+ | TEnum (n,at) -> TEnum(n,strip at)
+
+(* Remove the last attribute from the toplevel and return the changed type *)
+let strip_last_attribute typ =
+ let rec hd_opt l = match l with
+ [] -> None,[]
+ | a::rest -> Some a,rest in
+ match typ with
+ | TVoid at -> let l,r = hd_opt at in
+ l,TVoid r
+ | TInt (k,at) -> let l,r = hd_opt at in
+ l,TInt (k,r)
+ | TFloat (k,at) -> let l,r = hd_opt at in
+ l,TFloat (k,r)
+ | TPtr (t,at) -> let l,r = hd_opt at in
+ l,TPtr(t,r)
+ | TArray (t,s,at) -> let l,r = hd_opt at in
+ l,TArray(t,s,r)
+ | TFun (t,arg,v,at) -> let l,r = hd_opt at in
+ l,TFun(t,arg,v,r)
+ | TNamed (n,at) -> let l,r = hd_opt at in
+ l,TNamed(n,r)
+ | TStruct (n,at) -> let l,r = hd_opt at in
+ l,TStruct(n,r)
+ | TUnion (n,at) -> let l,r = hd_opt at in
+ l,TUnion(n,r)
+ | TEnum (n,at) -> let l,r = hd_opt at in
+ l,TEnum(n,r)
+
(* Extracting alignment value from a set of attributes. Return 0 if none. *)
let alignas_attribute al =
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index a322bfb1..a09316ad 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -56,6 +56,10 @@ val attr_is_type_related: attribute -> bool
(* Is an attribute type-related (true) or variable-related (false)? *)
val attr_inherited_by_members: attribute -> bool
(* Is an attribute of a composite inherited by members of the composite? *)
+val strip_attributes_type: typ -> attribute list -> typ
+ (* Remove all attributes from the given type that are not contained in the list *)
+val strip_last_attribute: typ -> attribute option * typ
+ (* Remove the last top level attribute and return it *)
(* Type compatibility *)
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 3e40fa41..96355d66 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -60,47 +60,7 @@ let typ_to_string (ty: typ) =
Buffer.contents buf
(* Helper functions for the attributes *)
-let strip_attributes typ =
- let strip = List.filter (fun a -> a = AConst || a = AVolatile) in
- match typ with
- | TVoid at -> TVoid (strip at)
- | TInt (k,at) -> TInt (k,strip at)
- | TFloat (k,at) -> TFloat(k,strip at)
- | TPtr (t,at) -> TPtr(t,strip at)
- | TArray (t,s,at) -> TArray(t,s,strip at)
- | TFun (t,arg,v,at) -> TFun(t,arg,v,strip at)
- | TNamed (n,at) -> TNamed(n,strip at)
- | TStruct (n,at) -> TStruct(n,strip at)
- | TUnion (n,at) -> TUnion(n,strip at)
- | TEnum (n,at) -> TEnum(n,strip at)
-
-let strip_last_attribute typ =
- let rec hd_opt l = match l with
- [] -> None,[]
- | AConst::rest -> Some AConst,rest
- | AVolatile::rest -> Some AVolatile,rest
- | _::rest -> hd_opt rest in
- match typ with
- | TVoid at -> let l,r = hd_opt at in
- l,TVoid r
- | TInt (k,at) -> let l,r = hd_opt at in
- l,TInt (k,r)
- | TFloat (k,at) -> let l,r = hd_opt at in
- l,TFloat (k,r)
- | TPtr (t,at) -> let l,r = hd_opt at in
- l,TPtr(t,r)
- | TArray (t,s,at) -> let l,r = hd_opt at in
- l,TArray(t,s,r)
- | TFun (t,arg,v,at) -> let l,r = hd_opt at in
- l,TFun(t,arg,v,r)
- | TNamed (n,at) -> let l,r = hd_opt at in
- l,TNamed(n,r)
- | TStruct (n,at) -> let l,r = hd_opt at in
- l,TStruct(n,r)
- | TUnion (n,at) -> let l,r = hd_opt at in
- l,TUnion(n,r)
- | TEnum (n,at) -> let l,r = hd_opt at in
- l,TEnum(n,r)
+let strip_attributes typ = strip_attributes_type typ [AConst;AVolatile]
(* Does the type already exist? *)
let exist_type (ty: typ) =