From 3babd253e1d194549294c282e1b0c60097b26b07 Mon Sep 17 00:00:00 2001
From: Xavier Leroy <xavier.leroy@inria.fr>
Date: Fri, 3 Feb 2017 14:12:32 +0100
Subject: Refactor the classification of attributes

Introduce Cutil.class_of_attribute to return the class of the given attribute: one among
Attr_type  attribute related to types  (e.g. "aligned")
Attr_struct attribute related to struct/union/enum types (e.g. "packed")
Attr_function attribute related to function types (e.g. "noreturn")
Attr_name  attribute related to variable and function declarations (e.g. "section")
Attr_unknown  attribute was not declared

Cutil.declare_attribute is used to associate a class to a custom attribute.
Standard attributes (const, volatile, _Alignas, etc) are Attr_type.

cfronted/C2C.ml: declare the few attributes that CompCert honors currently.
cparser/GCC.ml: a bigger list of attributes taken from GCC, for reference only.
---
 cparser/Cutil.ml | 44 ++++++++++++++++++++++++++++++++------------
 1 file changed, 32 insertions(+), 12 deletions(-)

(limited to 'cparser/Cutil.ml')

diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 21e6f71e..44d16ea1 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -37,6 +37,15 @@ module IdentMap = Map.Make(Ident)
 
 (* Operations on attributes *)
 
+(* Normalize the name of an attribute, removing starting and trailing '__' *)
+
+let re_normalize_attrname = Str.regexp "^__\\(.*\\)__$"
+
+let normalize_attrname a =
+  if Str.string_match re_normalize_attrname a 0
+  then Str.matched_group 1 a
+  else a
+
 (* Lists of attributes are kept sorted in increasing order *)
 
 let rec add_attributes (al1: attributes) (al2: attributes) =
@@ -83,23 +92,34 @@ let rec remove_custom_attributes (names: string list)  (al: attributes) =
   | a :: tl ->
       a :: remove_custom_attributes names tl
 
-(* Is an attribute a ISO C standard attribute? *)
+(* Classification of attributes *)
 
-let attr_is_standard = function
-  | AConst | AVolatile | ARestrict -> true
-  | AAlignas _ | Attr _ -> false
+type attribute_class =
+  | Attr_name           (* Attribute applies to the names being declared  *)
+  | Attr_type           (* Attribute applies to types *)
+  | Attr_struct         (* Attribute applies to struct, union and enum *)
+  | Attr_function       (* Attribute applies to function types and decls *)
+  | Attr_unknown        (* Unknown attribute *)
+      
+let attr_class : (string, attribute_class) Hashtbl.t = Hashtbl.create 32
 
-(* Is an attribute type-related (true) or variable-related (false)? *)
+let declare_attribute name cls =
+  Hashtbl.replace attr_class (normalize_attrname name) cls
 
-let attr_is_type_related = function
-  | AConst | AVolatile | ARestrict | AAlignas _ -> true
-  | Attr(_, _) -> false
+let declare_attributes l =
+  List.iter (fun (n,c) -> declare_attribute n c) l
 
-(* Is an attribute related to structs, unions and enum (true) or not (false)? *)
+let class_of_attribute = function
+  | AConst | AVolatile | ARestrict | AAlignas _ -> Attr_type
+  | Attr(name, args) ->
+      try Hashtbl.find attr_class (normalize_attrname name)
+      with Not_found -> Attr_unknown
 
-let attr_is_struct_related = function
-  | Attr(("packed" | "__packed__"), _) -> true
-  | _ -> false
+(* Is an attribute a ISO C standard attribute? *)
+
+let attr_is_standard = function
+  | AConst | AVolatile | ARestrict -> true
+  | AAlignas _ | Attr _ -> false
 
 (* Is an attribute applicable to a whole array (true) or only to
    array elements (false)? *)
-- 
cgit