Implement support for C11 generic expressions

Used Bytes.set/get for in-place string modification across project.
Strings are immutable in recent OCaml versions, and Bytes should be used instead. This will allow the project to build on recent OCaml versions.

Fix encoding issues

Reencode file to allow make

Implement productions and matching Cabs.ml types.
Add patch in cil-project/cil#30 to allow compilation.

Implement _Generic expression visiting & extraction of their type(s)

Simplify assoc. list type checks in _Generic

Improve code explanation for understandability

Implement simplified type checks for assoc. list in _Generic types

Use built-in type comparison. Fix bug in default case expression generation.

lib/perl5/App/Cilly.pm.in

@@ -2212,7 +2212,7 @@ sub setVersion {
          . join(' ', @{$self->{PPARGS}}) ." |") 
         || die "Cannot start GNUCC";
     while(<VER>) {
-        if($_ =~ m|^(\d+\S+)| || $_ =~ m|^(egcs-\d+\S+)|) {
+        if($_ =~ m|^(\d+\S+)| || $_ =~ m|^(\d+)$| || $_ =~ m|^(egcs-\d+\S+)|) {
             $cversion = "gcc_$1";
             close(VER) || die "Cannot start GNUCC\n";
             $self->{CVERSION} = $cversion;

src/frontc/cabs.ml

@@ -38,7 +38,7 @@
 (** This file was originally part of Hugues Casee's frontc 2.0, and has been 
  * extensively changed since. 
 **
-** 1.0	3.22.99	Hugues Cassé	First version.
+** 1.0	3.22.99	Hugues Cassé	First version.
 ** 2.0  George Necula 12/12/00: Many extensions
  **)
 
@@ -277,6 +277,7 @@ and expression =
   | MEMBEROFPTR of expression * string
   | GNU_BODY of block
   | EXPR_PATTERN of string     (* pattern variable, and name *)
+  | GENERIC of expression * (((specifier * decl_type) option * expression) list) 
 
 and constant =
   | CONST_INT of string   (* the textual representation *)

src/frontc/cabs2cil.ml

@@ -51,6 +51,7 @@ open Cabshelper
 open Pretty
 open Cil
 open Cilint
+open Expcompare
 open Trace
 
 
@@ -3053,7 +3054,6 @@ and doOnlyType (specs: A.spec_elem list) (dt: A.decl_type) : typ =
            d_attrlist nattr);
   tres
 
-
 and makeCompType (isstruct: bool)
                  (n: string)
                  (nglist: A.field_group list) 
@@ -4037,6 +4037,45 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
               intType
     end
 
+    | A.GENERIC (e, lst) ->
+      let compare_types t_1 t_2 =
+          match t_1, t_2 with
+            | Some t_1', Some t_2'  -> compareTypesNoAttributes t_1' t_2'
+            | _                     -> false
+        in
+
+        (* Map over all type "matches" [type_1:expr_1] defined in  _Generic(T, type_1: expr_1, ..., default: expr_n). *)
+        let mapped = List.map (fun (opt, exp) ->
+          match opt with
+          (* If None, then we've found the default. *)
+          | None -> (None, exp)
+          (* If Some, then we've found a type match (type_1 above above). Find the Cil.typ of this type. *)
+          | Some (spec, decl) ->
+              let declaration_type = doOnlyType spec decl in
+              (Some declaration_type, exp)
+        )
+        lst in
+
+        (* Find the type of the value fed to the generic expression (T above). *)
+        let (chunk, expr, t_typ) = doExp false e (AExp None) in
+
+        (* Find the matching type in the type matches. *)
+        let found_match = List.find_opt (fun (match_type, e) -> compare_types (Some t_typ) match_type) mapped in
+        (* Find the default expression. *)
+        let found_default = List.find_opt (fun (match_type, e) -> match_type == None) mapped in
+
+        let res = match found_match, found_default with
+          (* A matching type in the assoc. list of _Generic was found,
+             find blockchunk and Cil expression for the matching expression. *)
+          | Some(Some res, exp), _ -> doExp false exp (AExp None)
+          (* No types matched, use the default expression. *)
+          | None, Some((None, exp)) -> doExp false exp (AExp None)
+          (* No types matched, raise an error.
+             We should hopefully see a compile time error before we reach this case. *)
+          | _ -> E.s (error "Could not find matching type for %a in _Generic @" d_plaintype t_typ)
+        in
+        res
+
     | A.CALL(f, args) -> 
         if asconst then
           ignore (warnOpt "CALL in constant");

src/frontc/cabsvisit.ml

@@ -531,6 +531,7 @@ and childrenExpression vis e =
       let b' = visitCabsBlock vis b in
       if b' != b then GNU_BODY b' else e
   | EXPR_PATTERN _ -> e
+  | GENERIC (expr, lst) -> GENERIC (ve expr, List.map (fun (opt, expr) -> (opt, ve expr)) lst)
 
 and visitCabsInitExpression vis (ie: init_expression) : init_expression = 
   doVisit vis vis#vinitexpr childrenInitExpression ie

src/frontc/clexer.mll

@@ -37,7 +37,7 @@
  *)
 (* FrontC -- lexical analyzer
 **
-** 1.0	3.22.99	Hugues Cassé	First version.
+** 1.0	3.22.99	Hugues Cassé	First version.
 ** 2.0  George Necula 12/12/00: Many extensions
 *)
 {
@@ -175,6 +175,7 @@ let init_lexicon _ =
       ("__typeof__", fun loc -> TYPEOF loc);
       ("__typeof", fun loc -> TYPEOF loc);
       ("typeof", fun loc -> TYPEOF loc); 
+      ("_Generic", fun loc -> GENERIC loc); 
       ("__alignof", fun loc -> ALIGNOF loc);
       ("__alignof__", fun loc -> ALIGNOF loc);
       ("__volatile__", fun loc -> VOLATILE loc);

src/frontc/cparser.mly

@@ -36,7 +36,7 @@
  *
  **)
 (**
-** 1.0	3.22.99	Hugues Cassé	First version.
+** 1.0	3.22.99	Hugues Cassé 	First version.
 ** 2.0  George Necula 12/12/00: Practically complete rewrite.
 *)
 */
@@ -256,7 +256,7 @@ let transformOffsetOf (speclist, dtype) member =
 %token EOF
 %token<Cabs.cabsloc> CHAR INT BOOL DOUBLE FLOAT VOID INT128 INT64 INT32
 %token<Cabs.cabsloc> ENUM STRUCT TYPEDEF UNION
-%token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT
+%token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT GENERIC
 %token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
 %token<Cabs.cabsloc> THREAD
 
@@ -469,10 +469,27 @@ primary_expression:                     /*(* 6.5.1. *)*/
 		        {PAREN (smooth_expression (fst $1)), snd $1}
 |		LPAREN block RPAREN
 		        { GNU_BODY (fst3 $2), $1 }
-
      /*(* Next is Scott's transformer *)*/
 |               AT_EXPR LPAREN IDENT RPAREN         /* expression pattern variable */
                          { EXPR_PATTERN(fst $3), $1 }
+| generic_selection
+    { $1 }
+
+generic_selection: 
+| GENERIC LPAREN assignment_expression COMMA generic_assoc_list RPAREN
+    { GENERIC((fst $3), $5), $1 }
+
+generic_assoc_list:
+| generic_association 
+    { [$1] }
+| generic_assoc_list COMMA generic_association
+    { $3 :: $1 }
+
+generic_association: 
+| type_name COLON assignment_expression
+    { Some($1), (fst $3) }
+| DEFAULT COLON assignment_expression
+    { None, (fst $3) }
 ;
 
 postfix_expression:                     /*(* 6.5.2 *)*/

src/frontc/cprint.ml

@@ -41,28 +41,28 @@
 ** File:	cprint.ml
 ** Version:	2.1e
 ** Date:	9.1.99
-** Author:	Hugues Cassé
+** Author:	Hugues Cassé
 **
-**	1.0		2.22.99	Hugues Cassé	First version.
-**	2.0		3.18.99	Hugues Cassé	Compatible with Frontc 2.1, use of CAML
+**	1.0		2.22.99	Hugues Cassé	First version.
+**	2.0		3.18.99	Hugues Cassé	Compatible with Frontc 2.1, use of CAML
 **									pretty printer.
-**	2.1		3.22.99	Hugues Cassé	More efficient custom pretty printer used.
-**	2.1a	4.12.99	Hugues Cassé	Correctly handle:
+**	2.1		3.22.99	Hugues Cassé	More efficient custom pretty printer used.
+**	2.1a	4.12.99	Hugues Cassé	Correctly handle:
 **									char *m, *m, *p; m + (n - p)
-**	2.1b	4.15.99	Hugues Cassé	x + (y + z) stays x + (y + z) for
+**	2.1b	4.15.99	Hugues Cassé	x + (y + z) stays x + (y + z) for
 **									keeping computation order.
-**	2.1c	7.23.99	Hugues Cassé	Improvement of case and default display.
-**	2.1d	8.25.99	Hugues Cassé	Rebuild escape sequences in string and
+**	2.1c	7.23.99	Hugues Cassé	Improvement of case and default display.
+**	2.1d	8.25.99	Hugues Cassé	Rebuild escape sequences in string and
 **									characters.
-**	2.1e	9.1.99	Hugues Cassé	Fix, recognize and correctly display '\0'.
+**	2.1e	9.1.99	Hugues Cassé	Fix, recognize and correctly display '\0'.
 *)
 
 (* George Necula: I changed this pretty dramatically since CABS changed *)
 open Cabs
 open Escape
 open Whitetrack
 
-let version = "Cprint 2.1e 9.1.99 Hugues Cassé"
+let version = "Cprint 2.1e 9.1.99 Hugues Cassé"
 
 type loc = { line : int; file : string }
 
@@ -544,6 +544,7 @@ and print_expression_level (lvl: int) (exp : expression) =
       print ")"
   | EXPR_PATTERN (name) ->
       printl ["@expr";"(";name;")"]
+  | GENERIC _ -> print "_Generic(...)"
   in
   ()