--- /dev/null
+/*(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ **)
+(**
+** 1.0 3.22.99 Hugues Cassé First version.
+** 2.0 George Necula 12/12/00: Practically complete rewrite.
+*)
+*/
+%{
+open Cabs
+open Cabshelper
+open Parse_aux
+
+(*
+** Expression building
+*)
+let smooth_expression lst =
+ match lst with
+ [] -> NOTHING
+ | [expr] -> expr
+ | _ -> COMMA (lst)
+
+
+let currentFunctionName = ref "<outside any function>"
+
+let announceFunctionName ((n, decl, _, _):name) =
+ !add_identifier n;
+ (* Start a context that includes the parameter names and the whole body.
+ * Will pop when we finish parsing the function body *)
+ !push_context ();
+ (* Go through all the parameter names and mark them as identifiers *)
+ let rec findProto = function
+ PROTO (d, args, _) when isJUSTBASE d ->
+ List.iter (fun (_, (an, _, _, _)) -> !add_identifier an) args
+
+ | PROTO (d, _, _) -> findProto d
+ | PARENTYPE (_, d, _) -> findProto d
+ | PTR (_, d) -> findProto d
+ | ARRAY (d, _, _) -> findProto d
+ | _ -> parse_error "Cannot find the prototype in a function definition";
+ raise Parsing.Parse_error
+
+ and isJUSTBASE = function
+ JUSTBASE -> true
+ | PARENTYPE (_, d, _) -> isJUSTBASE d
+ | _ -> false
+ in
+ findProto decl;
+ currentFunctionName := n
+
+
+
+let applyPointer (ptspecs: attribute list list) (dt: decl_type)
+ : decl_type =
+ (* Outer specification first *)
+ let rec loop = function
+ [] -> dt
+ | attrs :: rest -> PTR(attrs, loop rest)
+ in
+ loop ptspecs
+
+let doDeclaration (loc: cabsloc) (specs: spec_elem list) (nl: init_name list) : definition =
+ if isTypedef specs then begin
+ (* Tell the lexer about the new type names *)
+ List.iter (fun ((n, _, _, _), _) -> !add_type n) nl;
+ TYPEDEF ((specs, List.map (fun (n, _) -> n) nl), loc)
+ end else
+ if nl = [] then
+ ONLYTYPEDEF (specs, loc)
+ else begin
+ (* Tell the lexer about the new variable names *)
+ List.iter (fun ((n, _, _, _), _) -> !add_identifier n) nl;
+ DECDEF ((specs, nl), loc)
+ end
+
+
+let doFunctionDef (loc: cabsloc)
+ (lend: cabsloc)
+ (specs: spec_elem list)
+ (n: name)
+ (b: block) : definition =
+ let fname = (specs, n) in
+ FUNDEF (fname, b, loc, lend)
+
+
+let doOldParDecl (names: string list)
+ ((pardefs: name_group list), (isva: bool))
+ : single_name list * bool =
+ let findOneName n =
+ (* Search in pardefs for the definition for this parameter *)
+ let rec loopGroups = function
+ [] -> ([SpecType Tint], (n, JUSTBASE, [], cabslu))
+ | (specs, names) :: restgroups ->
+ let rec loopNames = function
+ [] -> loopGroups restgroups
+ | ((n',_, _, _) as sn) :: _ when n' = n -> (specs, sn)
+ | _ :: restnames -> loopNames restnames
+ in
+ loopNames names
+ in
+ loopGroups pardefs
+ in
+ let args = List.map findOneName names in
+ (args, isva)
+
+let int64_to_char value =
+ if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
+ begin
+ let msg = Printf.sprintf "cparser:intlist_to_string: character 0x%Lx too big" value in
+ parse_error msg;
+ raise Parsing.Parse_error
+ end
+ else
+ Char.chr (Int64.to_int value)
+
+(* takes a not-nul-terminated list, and converts it to a string. *)
+let rec intlist_to_string (str: int64 list):string =
+ match str with
+ [] -> "" (* add nul-termination *)
+ | value::rest ->
+ let this_char = int64_to_char value in
+ (String.make 1 this_char) ^ (intlist_to_string rest)
+
+let fst3 (result, _, _) = result
+let snd3 (_, result, _) = result
+let trd3 (_, _, result) = result
+
+
+(*
+ transform: __builtin_offsetof(type, member)
+ into : (size_t) (&(type * ) 0)->member
+ *)
+
+let transformOffsetOf (speclist, dtype) member =
+ let rec addPointer = function
+ | JUSTBASE ->
+ PTR([], JUSTBASE)
+ | PARENTYPE (attrs1, dtype, attrs2) ->
+ PARENTYPE (attrs1, addPointer dtype, attrs2)
+ | ARRAY (dtype, attrs, expr) ->
+ ARRAY (addPointer dtype, attrs, expr)
+ | PTR (attrs, dtype) ->
+ PTR (attrs, addPointer dtype)
+ | PROTO (dtype, names, variadic) ->
+ PROTO (addPointer dtype, names, variadic)
+ in
+ let nullType = (speclist, addPointer dtype) in
+ let nullExpr = CONSTANT (CONST_INT "0") in
+ let castExpr = CAST (nullType, SINGLE_INIT nullExpr) in
+
+ let rec replaceBase = function
+ | VARIABLE field ->
+ MEMBEROFPTR (castExpr, field)
+ | MEMBEROF (base, field) ->
+ MEMBEROF (replaceBase base, field)
+ | INDEX (base, index) ->
+ INDEX (replaceBase base, index)
+ | _ ->
+ parse_error "malformed offset expression in __builtin_offsetof";
+ raise Parsing.Parse_error
+ in
+ let memberExpr = replaceBase member in
+ let addrExpr = UNARY (ADDROF, memberExpr) in
+ (* slight cheat: hard-coded assumption that size_t == unsigned int *)
+ let sizeofType = [SpecType Tunsigned], JUSTBASE in
+ let resultExpr = CAST (sizeofType, SINGLE_INIT addrExpr) in
+ resultExpr
+
+%}
+
+%token <string * Cabs.cabsloc> IDENT
+%token <int64 list * Cabs.cabsloc> CST_CHAR
+%token <int64 list * Cabs.cabsloc> CST_WCHAR
+%token <string * Cabs.cabsloc> CST_INT
+%token <string * Cabs.cabsloc> CST_FLOAT
+%token <string * Cabs.cabsloc> NAMED_TYPE
+
+/* Each character is its own list element, and the terminating nul is not
+ included in this list. */
+%token <int64 list * Cabs.cabsloc> CST_STRING
+%token <int64 list * Cabs.cabsloc> CST_WSTRING
+
+%token EOF
+%token<Cabs.cabsloc> CHAR INT DOUBLE FLOAT VOID INT64 INT32 UNDERSCORE_BOOL
+%token<Cabs.cabsloc> ENUM STRUCT TYPEDEF UNION
+%token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT
+%token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
+%token<Cabs.cabsloc> THREAD
+
+%token<Cabs.cabsloc> SIZEOF ALIGNOF
+
+%token EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+%token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+%token ARROW DOT
+
+%token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
+%token<Cabs.cabsloc> PLUS MINUS STAR
+%token SLASH PERCENT
+%token<Cabs.cabsloc> TILDE AND
+%token PIPE CIRC
+%token<Cabs.cabsloc> EXCLAM AND_AND
+%token PIPE_PIPE
+%token INF_INF SUP_SUP
+%token<Cabs.cabsloc> PLUS_PLUS MINUS_MINUS
+
+%token RPAREN
+%token<Cabs.cabsloc> LPAREN RBRACE
+%token<Cabs.cabsloc> LBRACE
+%token LBRACKET RBRACKET
+%token COLON
+%token<Cabs.cabsloc> SEMICOLON
+%token COMMA ELLIPSIS QUEST
+
+%token<Cabs.cabsloc> BREAK CONTINUE GOTO RETURN
+%token<Cabs.cabsloc> SWITCH CASE DEFAULT
+%token<Cabs.cabsloc> WHILE DO FOR
+%token<Cabs.cabsloc> IF TRY EXCEPT FINALLY
+%token ELSE
+
+%token<Cabs.cabsloc> ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__
+%token LABEL__
+%token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED
+%token BUILTIN_VA_LIST
+%token BLOCKATTRIBUTE
+%token<Cabs.cabsloc> BUILTIN_TYPES_COMPAT BUILTIN_OFFSETOF
+%token<Cabs.cabsloc> DECLSPEC
+%token<string * Cabs.cabsloc> MSASM MSATTR
+%token<string * Cabs.cabsloc> PRAGMA_LINE
+%token PRAGMA_EOL
+
+/* operator precedence */
+%nonassoc IF
+%nonassoc ELSE
+
+
+%left COMMA
+%right EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+ AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+%right QUEST COLON
+%left PIPE_PIPE
+%left AND_AND
+%left PIPE
+%left CIRC
+%left AND
+%left EQ_EQ EXCLAM_EQ
+%left INF SUP INF_EQ SUP_EQ
+%left INF_INF SUP_SUP
+%left PLUS MINUS
+%left STAR SLASH PERCENT CONST RESTRICT VOLATILE
+%right EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
+%left LBRACKET
+%left DOT ARROW LPAREN LBRACE
+%right NAMED_TYPE /* We'll use this to handle redefinitions of
+ * NAMED_TYPE as variables */
+%left IDENT
+
+/* Non-terminals informations */
+%start interpret file
+%type <Cabs.definition list> file interpret globals
+
+%type <Cabs.definition> global
+
+
+%type <Cabs.attribute list> attributes attributes_with_asm asmattr
+%type <Cabs.statement> statement
+%type <Cabs.constant * cabsloc> constant
+%type <string * cabsloc> string_constant
+%type <Cabs.expression * cabsloc> expression
+%type <Cabs.expression> opt_expression
+%type <Cabs.init_expression> init_expression
+%type <Cabs.expression list * cabsloc> comma_expression
+%type <Cabs.expression list * cabsloc> paren_comma_expression
+%type <Cabs.expression list> arguments
+%type <Cabs.expression list> bracket_comma_expression
+%type <int64 list Queue.t * cabsloc> string_list
+%type <int64 list * cabsloc> wstring_list
+
+%type <Cabs.initwhat * Cabs.init_expression> initializer
+%type <(Cabs.initwhat * Cabs.init_expression) list> initializer_list
+%type <Cabs.initwhat> init_designators init_designators_opt
+
+%type <spec_elem list * cabsloc> decl_spec_list
+%type <typeSpecifier * cabsloc> type_spec
+%type <Cabs.field_group list> struct_decl_list
+
+
+%type <Cabs.name> old_proto_decl
+%type <Cabs.single_name> parameter_decl
+%type <Cabs.enum_item> enumerator
+%type <Cabs.enum_item list> enum_list
+%type <Cabs.definition> declaration function_def
+%type <cabsloc * spec_elem list * name> function_def_start
+%type <Cabs.spec_elem list * Cabs.decl_type> type_name
+%type <Cabs.block * cabsloc * cabsloc> block
+%type <Cabs.statement list> block_element_list
+%type <string list> local_labels local_label_names
+%type <string list> old_parameter_list_ne
+
+%type <Cabs.init_name> init_declarator
+%type <Cabs.init_name list> init_declarator_list
+%type <Cabs.name> declarator
+%type <Cabs.name * expression option> field_decl
+%type <(Cabs.name * expression option) list> field_decl_list
+%type <string * Cabs.decl_type> direct_decl
+%type <Cabs.decl_type> abs_direct_decl abs_direct_decl_opt
+%type <Cabs.decl_type * Cabs.attribute list> abstract_decl
+
+ /* (* Each element is a "* <type_quals_opt>". *) */
+%type <attribute list list * cabsloc> pointer pointer_opt
+%type <Cabs.cabsloc> location
+%type <Cabs.spec_elem * cabsloc> cvspec
+%%
+
+interpret:
+ file EOF {$1}
+;
+file: globals {$1}
+;
+globals:
+ /* empty */ { [] }
+| global globals { $1 :: $2 }
+| SEMICOLON globals { $2 }
+;
+
+location:
+ /* empty */ { currentLoc () } %prec IDENT
+
+
+/*** Global Definition ***/
+global:
+| declaration { $1 }
+| function_def { $1 }
+/*(* Some C header files ar shared with the C++ compiler and have linkage
+ * specification *)*/
+| EXTERN string_constant declaration { LINKAGE (fst $2, (*handleLoc*) (snd $2), [ $3 ]) }
+| EXTERN string_constant LBRACE globals RBRACE
+ { LINKAGE (fst $2, (*handleLoc*) (snd $2), $4) }
+| ASM LPAREN string_constant RPAREN SEMICOLON
+ { GLOBASM (fst $3, (*handleLoc*) $1) }
+| pragma { $1 }
+/* (* Old-style function prototype. This should be somewhere else, like in
+ * "declaration". For now we keep it at global scope only because in local
+ * scope it looks too much like a function call *) */
+| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list SEMICOLON
+ { (* Convert pardecl to new style *)
+ let pardecl, isva = doOldParDecl $3 $5 in
+ (* Make the function declarator *)
+ doDeclaration ((*handleLoc*) (snd $1)) []
+ [((fst $1, PROTO(JUSTBASE, pardecl,isva), [], cabslu),
+ NO_INIT)]
+ }
+/* (* Old style function prototype, but without any arguments *) */
+| IDENT LPAREN RPAREN SEMICOLON
+ { (* Make the function declarator *)
+ doDeclaration ((*handleLoc*)(snd $1)) []
+ [((fst $1, PROTO(JUSTBASE,[],false), [], cabslu),
+ NO_INIT)]
+ }
+/* | location error SEMICOLON { PRAGMA (VARIABLE "parse_error", $1) } */
+;
+
+id_or_typename:
+ IDENT {fst $1}
+| NAMED_TYPE {fst $1}
+;
+
+maybecomma:
+ /* empty */ { () }
+| COMMA { () }
+;
+
+/* *** Expressions *** */
+
+primary_expression: /*(* 6.5.1. *)*/
+| IDENT
+ {VARIABLE (fst $1), snd $1}
+| constant
+ {CONSTANT (fst $1), snd $1}
+| paren_comma_expression
+ {PAREN (smooth_expression (fst $1)), snd $1}
+| LPAREN block RPAREN
+ { GNU_BODY (fst3 $2), $1 }
+;
+
+postfix_expression: /*(* 6.5.2 *)*/
+| primary_expression
+ { $1 }
+| postfix_expression bracket_comma_expression
+ {INDEX (fst $1, smooth_expression $2), snd $1}
+| postfix_expression LPAREN arguments RPAREN
+ {CALL (fst $1, $3), snd $1}
+| BUILTIN_VA_ARG LPAREN expression COMMA type_name RPAREN
+ { let b, d = $5 in
+ CALL (VARIABLE "__builtin_va_arg",
+ [fst $3; TYPE_SIZEOF (b, d)]), $1 }
+| BUILTIN_TYPES_COMPAT LPAREN type_name COMMA type_name RPAREN
+ { let b1,d1 = $3 in
+ let b2,d2 = $5 in
+ CALL (VARIABLE "__builtin_types_compatible_p",
+ [TYPE_SIZEOF(b1,d1); TYPE_SIZEOF(b2,d2)]), $1 }
+| BUILTIN_OFFSETOF LPAREN type_name COMMA offsetof_member_designator RPAREN
+ { transformOffsetOf $3 $5, $1 }
+| postfix_expression DOT id_or_typename
+ {MEMBEROF (fst $1, $3), snd $1}
+| postfix_expression ARROW id_or_typename
+ {MEMBEROFPTR (fst $1, $3), snd $1}
+| postfix_expression PLUS_PLUS
+ {UNARY (POSINCR, fst $1), snd $1}
+| postfix_expression MINUS_MINUS
+ {UNARY (POSDECR, fst $1), snd $1}
+/* (* We handle GCC constructor expressions *) */
+| LPAREN type_name RPAREN LBRACE initializer_list_opt RBRACE
+ { CAST($2, COMPOUND_INIT $5), $1 }
+;
+
+offsetof_member_designator: /* GCC extension for __builtin_offsetof */
+| id_or_typename
+ { VARIABLE ($1) }
+| offsetof_member_designator DOT IDENT
+ { MEMBEROF ($1, fst $3) }
+| offsetof_member_designator bracket_comma_expression
+ { INDEX ($1, smooth_expression $2) }
+;
+
+unary_expression: /*(* 6.5.3 *)*/
+| postfix_expression
+ { $1 }
+| PLUS_PLUS unary_expression
+ {UNARY (PREINCR, fst $2), $1}
+| MINUS_MINUS unary_expression
+ {UNARY (PREDECR, fst $2), $1}
+| SIZEOF unary_expression
+ {EXPR_SIZEOF (fst $2), $1}
+| SIZEOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_SIZEOF (b, d), $1}
+| ALIGNOF unary_expression
+ {EXPR_ALIGNOF (fst $2), $1}
+| ALIGNOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_ALIGNOF (b, d), $1}
+| PLUS cast_expression
+ {UNARY (PLUS, fst $2), $1}
+| MINUS cast_expression
+ {UNARY (MINUS, fst $2), $1}
+| STAR cast_expression
+ {UNARY (MEMOF, fst $2), $1}
+| AND cast_expression
+ {UNARY (ADDROF, fst $2), $1}
+| EXCLAM cast_expression
+ {UNARY (NOT, fst $2), $1}
+| TILDE cast_expression
+ {UNARY (BNOT, fst $2), $1}
+| AND_AND IDENT { LABELADDR (fst $2), $1 }
+;
+
+cast_expression: /*(* 6.5.4 *)*/
+| unary_expression
+ { $1 }
+| LPAREN type_name RPAREN cast_expression
+ { CAST($2, SINGLE_INIT (fst $4)), $1 }
+;
+
+multiplicative_expression: /*(* 6.5.5 *)*/
+| cast_expression
+ { $1 }
+| multiplicative_expression STAR cast_expression
+ {BINARY(MUL, fst $1, fst $3), snd $1}
+| multiplicative_expression SLASH cast_expression
+ {BINARY(DIV, fst $1, fst $3), snd $1}
+| multiplicative_expression PERCENT cast_expression
+ {BINARY(MOD, fst $1, fst $3), snd $1}
+;
+
+additive_expression: /*(* 6.5.6 *)*/
+| multiplicative_expression
+ { $1 }
+| additive_expression PLUS multiplicative_expression
+ {BINARY(ADD, fst $1, fst $3), snd $1}
+| additive_expression MINUS multiplicative_expression
+ {BINARY(SUB, fst $1, fst $3), snd $1}
+;
+
+shift_expression: /*(* 6.5.7 *)*/
+| additive_expression
+ { $1 }
+| shift_expression INF_INF additive_expression
+ {BINARY(SHL, fst $1, fst $3), snd $1}
+| shift_expression SUP_SUP additive_expression
+ {BINARY(SHR, fst $1, fst $3), snd $1}
+;
+
+
+relational_expression: /*(* 6.5.8 *)*/
+| shift_expression
+ { $1 }
+| relational_expression INF shift_expression
+ {BINARY(LT, fst $1, fst $3), snd $1}
+| relational_expression SUP shift_expression
+ {BINARY(GT, fst $1, fst $3), snd $1}
+| relational_expression INF_EQ shift_expression
+ {BINARY(LE, fst $1, fst $3), snd $1}
+| relational_expression SUP_EQ shift_expression
+ {BINARY(GE, fst $1, fst $3), snd $1}
+;
+
+equality_expression: /*(* 6.5.9 *)*/
+| relational_expression
+ { $1 }
+| equality_expression EQ_EQ relational_expression
+ {BINARY(EQ, fst $1, fst $3), snd $1}
+| equality_expression EXCLAM_EQ relational_expression
+ {BINARY(NE, fst $1, fst $3), snd $1}
+;
+
+
+bitwise_and_expression: /*(* 6.5.10 *)*/
+| equality_expression
+ { $1 }
+| bitwise_and_expression AND equality_expression
+ {BINARY(BAND, fst $1, fst $3), snd $1}
+;
+
+bitwise_xor_expression: /*(* 6.5.11 *)*/
+| bitwise_and_expression
+ { $1 }
+| bitwise_xor_expression CIRC bitwise_and_expression
+ {BINARY(XOR, fst $1, fst $3), snd $1}
+;
+
+bitwise_or_expression: /*(* 6.5.12 *)*/
+| bitwise_xor_expression
+ { $1 }
+| bitwise_or_expression PIPE bitwise_xor_expression
+ {BINARY(BOR, fst $1, fst $3), snd $1}
+;
+
+logical_and_expression: /*(* 6.5.13 *)*/
+| bitwise_or_expression
+ { $1 }
+| logical_and_expression AND_AND bitwise_or_expression
+ {BINARY(AND, fst $1, fst $3), snd $1}
+;
+
+logical_or_expression: /*(* 6.5.14 *)*/
+| logical_and_expression
+ { $1 }
+| logical_or_expression PIPE_PIPE logical_and_expression
+ {BINARY(OR, fst $1, fst $3), snd $1}
+;
+
+conditional_expression: /*(* 6.5.15 *)*/
+| logical_or_expression
+ { $1 }
+| logical_or_expression QUEST opt_expression COLON conditional_expression
+ {QUESTION (fst $1, $3, fst $5), snd $1}
+;
+
+/*(* The C spec says that left-hand sides of assignment expressions are unary
+ * expressions. GCC allows cast expressions in there ! *)*/
+
+assignment_expression: /*(* 6.5.16 *)*/
+| conditional_expression
+ { $1 }
+| cast_expression EQ assignment_expression
+ {BINARY(ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PLUS_EQ assignment_expression
+ {BINARY(ADD_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression MINUS_EQ assignment_expression
+ {BINARY(SUB_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression STAR_EQ assignment_expression
+ {BINARY(MUL_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression SLASH_EQ assignment_expression
+ {BINARY(DIV_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PERCENT_EQ assignment_expression
+ {BINARY(MOD_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression AND_EQ assignment_expression
+ {BINARY(BAND_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PIPE_EQ assignment_expression
+ {BINARY(BOR_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression CIRC_EQ assignment_expression
+ {BINARY(XOR_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression INF_INF_EQ assignment_expression
+ {BINARY(SHL_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression SUP_SUP_EQ assignment_expression
+ {BINARY(SHR_ASSIGN, fst $1, fst $3), snd $1}
+;
+
+expression: /*(* 6.5.17 *)*/
+ assignment_expression
+ { $1 }
+;
+
+
+constant:
+ CST_INT {CONST_INT (fst $1), snd $1}
+| CST_FLOAT {CONST_FLOAT (fst $1), snd $1}
+| CST_CHAR {CONST_CHAR (fst $1), snd $1}
+| CST_WCHAR {CONST_WCHAR (fst $1), snd $1}
+| string_constant {CONST_STRING (fst $1), snd $1}
+| wstring_list {CONST_WSTRING (fst $1), snd $1}
+;
+
+string_constant:
+/* Now that we know this constant isn't part of a wstring, convert it
+ back to a string for easy viewing. */
+ string_list {
+ let queue, location = $1 in
+ let buffer = Buffer.create (Queue.length queue) in
+ Queue.iter
+ (List.iter
+ (fun value ->
+ let char = int64_to_char value in
+ Buffer.add_char buffer char))
+ queue;
+ Buffer.contents buffer, location
+ }
+;
+one_string_constant:
+/* Don't concat multiple strings. For asm templates. */
+ CST_STRING {intlist_to_string (fst $1) }
+;
+string_list:
+ one_string {
+ let queue = Queue.create () in
+ Queue.add (fst $1) queue;
+ queue, snd $1
+ }
+| string_list one_string {
+ Queue.add (fst $2) (fst $1);
+ $1
+ }
+;
+
+wstring_list:
+ CST_WSTRING { $1 }
+| wstring_list one_string { (fst $1) @ (fst $2), snd $1 }
+| wstring_list CST_WSTRING { (fst $1) @ (fst $2), snd $1 }
+/* Only the first string in the list needs an L, so L"a" "b" is the same
+ * as L"ab" or L"a" L"b". */
+
+one_string:
+ CST_STRING {$1}
+| FUNCTION__ {(Cabshelper.explodeStringToInts
+ !currentFunctionName), $1}
+| PRETTY_FUNCTION__ {(Cabshelper.explodeStringToInts
+ !currentFunctionName), $1}
+;
+
+init_expression:
+ expression { SINGLE_INIT (fst $1) }
+| LBRACE initializer_list_opt RBRACE
+ { COMPOUND_INIT $2}
+
+initializer_list: /* ISO 6.7.8. Allow a trailing COMMA */
+ initializer { [$1] }
+| initializer COMMA initializer_list_opt { $1 :: $3 }
+;
+initializer_list_opt:
+ /* empty */ { [] }
+| initializer_list { $1 }
+;
+initializer:
+ init_designators eq_opt init_expression { ($1, $3) }
+| gcc_init_designators init_expression { ($1, $2) }
+| init_expression { (NEXT_INIT, $1) }
+;
+eq_opt:
+ EQ { () }
+ /*(* GCC allows missing = *)*/
+| /*(* empty *)*/ { () }
+;
+init_designators:
+ DOT id_or_typename init_designators_opt { INFIELD_INIT($2, $3) }
+| LBRACKET expression RBRACKET init_designators_opt
+ { ATINDEX_INIT(fst $2, $4) }
+| LBRACKET expression ELLIPSIS expression RBRACKET
+ { ATINDEXRANGE_INIT(fst $2, fst $4) }
+;
+init_designators_opt:
+ /* empty */ { NEXT_INIT }
+| init_designators { $1 }
+;
+
+gcc_init_designators: /*(* GCC supports these strange things *)*/
+ id_or_typename COLON { INFIELD_INIT($1, NEXT_INIT) }
+;
+
+arguments:
+ /* empty */ { [] }
+| comma_expression { fst $1 }
+;
+
+opt_expression:
+ /* empty */
+ {NOTHING}
+| comma_expression
+ {smooth_expression (fst $1)}
+;
+
+comma_expression:
+ expression {[fst $1], snd $1}
+| expression COMMA comma_expression { fst $1 :: fst $3, snd $1 }
+| error COMMA comma_expression { $3 }
+;
+
+comma_expression_opt:
+ /* empty */ { NOTHING }
+| comma_expression { smooth_expression (fst $1) }
+;
+
+paren_comma_expression:
+ LPAREN comma_expression RPAREN { $2 }
+| LPAREN error RPAREN { [], $1 }
+;
+
+bracket_comma_expression:
+ LBRACKET comma_expression RBRACKET { fst $2 }
+| LBRACKET error RBRACKET { [] }
+;
+
+
+/*** statements ***/
+block: /* ISO 6.8.2 */
+ block_begin local_labels block_attrs block_element_list RBRACE
+ {!pop_context();
+ { blabels = $2;
+ battrs = $3;
+ bstmts = $4 },
+ $1, $5
+ }
+| error location RBRACE { { blabels = [];
+ battrs = [];
+ bstmts = [] },
+ $2, $3
+ }
+;
+block_begin:
+ LBRACE {!push_context (); $1}
+;
+
+block_attrs:
+ /* empty */ { [] }
+| BLOCKATTRIBUTE paren_attr_list_ne
+ { [("__blockattribute__", $2)] }
+;
+
+/* statements and declarations in a block, in any order (for C99 support) */
+block_element_list:
+ /* empty */ { [] }
+| declaration block_element_list { DEFINITION($1) :: $2 }
+| statement block_element_list { $1 :: $2 }
+/*(* GCC accepts a label at the end of a block *)*/
+| IDENT COLON { [ LABEL (fst $1, NOP (snd $1),
+ snd $1)] }
+| pragma block_element_list { $2 }
+;
+
+local_labels:
+ /* empty */ { [] }
+| LABEL__ local_label_names SEMICOLON local_labels { $2 @ $4 }
+;
+local_label_names:
+ IDENT { [ fst $1 ] }
+| IDENT COMMA local_label_names { fst $1 :: $3 }
+;
+
+
+
+statement:
+ SEMICOLON {NOP ((*handleLoc*) $1) }
+| comma_expression SEMICOLON
+ {COMPUTATION (smooth_expression (fst $1), (*handleLoc*)(snd $1))}
+| block {BLOCK (fst3 $1, (*handleLoc*)(snd3 $1))}
+| IF paren_comma_expression statement %prec IF
+ {IF (smooth_expression (fst $2), $3, NOP $1, $1)}
+| IF paren_comma_expression statement ELSE statement
+ {IF (smooth_expression (fst $2), $3, $5, (*handleLoc*) $1)}
+| SWITCH paren_comma_expression statement
+ {SWITCH (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
+| WHILE paren_comma_expression statement
+ {WHILE (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
+| DO statement WHILE paren_comma_expression SEMICOLON
+ {DOWHILE (smooth_expression (fst $4), $2, (*handleLoc*) $1)}
+| FOR LPAREN for_clause opt_expression
+ SEMICOLON opt_expression RPAREN statement
+ {FOR ($3, $4, $6, $8, (*handleLoc*) $1)}
+| IDENT COLON attribute_nocv_list statement
+ {(* The only attribute that should appear here
+ is "unused". For now, we drop this on the
+ floor, since unused labels are usually
+ removed anyways by Rmtmps. *)
+ LABEL (fst $1, $4, (snd $1))}
+| CASE expression COLON statement
+ {CASE (fst $2, $4, (*handleLoc*) $1)}
+| CASE expression ELLIPSIS expression COLON statement
+ {CASERANGE (fst $2, fst $4, $6, (*handleLoc*) $1)}
+| DEFAULT COLON
+ {DEFAULT (NOP $1, (*handleLoc*) $1)}
+| RETURN SEMICOLON {RETURN (NOTHING, (*handleLoc*) $1)}
+| RETURN comma_expression SEMICOLON
+ {RETURN (smooth_expression (fst $2), (*handleLoc*) $1)}
+| BREAK SEMICOLON {BREAK ((*handleLoc*) $1)}
+| CONTINUE SEMICOLON {CONTINUE ((*handleLoc*) $1)}
+| GOTO IDENT SEMICOLON
+ {GOTO (fst $2, (*handleLoc*) $1)}
+| GOTO STAR comma_expression SEMICOLON
+ { COMPGOTO (smooth_expression (fst $3), (*handleLoc*) $1) }
+| ASM asmattr LPAREN asmtemplate asmoutputs RPAREN SEMICOLON
+ { ASM ($2, $4, $5, (*handleLoc*) $1) }
+| MSASM { ASM ([], [fst $1], None, (*handleLoc*)(snd $1))}
+| TRY block EXCEPT paren_comma_expression block
+ { let b, _, _ = $2 in
+ let h, _, _ = $5 in
+ if not !msvcMode then
+ parse_error "try/except in GCC code";
+ TRY_EXCEPT (b, COMMA (fst $4), h, (*handleLoc*) $1) }
+| TRY block FINALLY block
+ { let b, _, _ = $2 in
+ let h, _, _ = $4 in
+ if not !msvcMode then
+ parse_error "try/finally in GCC code";
+ TRY_FINALLY (b, h, (*handleLoc*) $1) }
+
+| error location SEMICOLON { (NOP $2)}
+;
+
+
+for_clause:
+ opt_expression SEMICOLON { FC_EXP $1 }
+| declaration { FC_DECL $1 }
+;
+
+declaration: /* ISO 6.7.*/
+ decl_spec_list init_declarator_list SEMICOLON
+ { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) $2 }
+| decl_spec_list SEMICOLON
+ { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) [] }
+;
+init_declarator_list: /* ISO 6.7 */
+ init_declarator { [$1] }
+| init_declarator COMMA init_declarator_list { $1 :: $3 }
+
+;
+init_declarator: /* ISO 6.7 */
+ declarator { ($1, NO_INIT) }
+| declarator EQ init_expression
+ { ($1, $3) }
+;
+
+decl_spec_list: /* ISO 6.7 */
+ /* ISO 6.7.1 */
+| TYPEDEF decl_spec_list_opt { SpecTypedef :: $2, $1 }
+| EXTERN decl_spec_list_opt { SpecStorage EXTERN :: $2, $1 }
+| STATIC decl_spec_list_opt { SpecStorage STATIC :: $2, $1 }
+| AUTO decl_spec_list_opt { SpecStorage AUTO :: $2, $1 }
+| REGISTER decl_spec_list_opt { SpecStorage REGISTER :: $2, $1}
+ /* ISO 6.7.2 */
+| type_spec decl_spec_list_opt_no_named { SpecType (fst $1) :: $2, snd $1 }
+ /* ISO 6.7.4 */
+| INLINE decl_spec_list_opt { SpecInline :: $2, $1 }
+| cvspec decl_spec_list_opt { (fst $1) :: $2, snd $1 }
+| attribute_nocv decl_spec_list_opt { SpecAttr (fst $1) :: $2, snd $1 }
+;
+/* (* In most cases if we see a NAMED_TYPE we must shift it. Thus we declare
+ * NAMED_TYPE to have right associativity *) */
+decl_spec_list_opt:
+ /* empty */ { [] } %prec NAMED_TYPE
+| decl_spec_list { fst $1 }
+;
+/* (* We add this separate rule to handle the special case when an appearance
+ * of NAMED_TYPE should not be considered as part of the specifiers but as
+ * part of the declarator. IDENT has higher precedence than NAMED_TYPE *)
+ */
+decl_spec_list_opt_no_named:
+ /* empty */ { [] } %prec IDENT
+| decl_spec_list { fst $1 }
+;
+type_spec: /* ISO 6.7.2 */
+ VOID { Tvoid, $1}
+| UNDERSCORE_BOOL { T_Bool, $1 }
+| CHAR { Tchar, $1 }
+| SHORT { Tshort, $1 }
+| INT { Tint, $1 }
+| LONG { Tlong, $1 }
+| INT64 { Tint64, $1 }
+| FLOAT { Tfloat, $1 }
+| DOUBLE { Tdouble, $1 }
+| SIGNED { Tsigned, $1 }
+| UNSIGNED { Tunsigned, $1 }
+| STRUCT id_or_typename
+ { Tstruct ($2, None, []), $1 }
+| STRUCT just_attributes id_or_typename
+ { Tstruct ($3, None, $2), $1 }
+| STRUCT id_or_typename LBRACE struct_decl_list RBRACE
+ { Tstruct ($2, Some $4, []), $1 }
+| STRUCT LBRACE struct_decl_list RBRACE
+ { Tstruct ("", Some $3, []), $1 }
+| STRUCT just_attributes id_or_typename LBRACE struct_decl_list RBRACE
+ { Tstruct ($3, Some $5, $2), $1 }
+| STRUCT just_attributes LBRACE struct_decl_list RBRACE
+ { Tstruct ("", Some $4, $2), $1 }
+| UNION id_or_typename
+ { Tunion ($2, None, []), $1 }
+| UNION id_or_typename LBRACE struct_decl_list RBRACE
+ { Tunion ($2, Some $4, []), $1 }
+| UNION LBRACE struct_decl_list RBRACE
+ { Tunion ("", Some $3, []), $1 }
+| UNION just_attributes id_or_typename LBRACE struct_decl_list RBRACE
+ { Tunion ($3, Some $5, $2), $1 }
+| UNION just_attributes LBRACE struct_decl_list RBRACE
+ { Tunion ("", Some $4, $2), $1 }
+| ENUM id_or_typename
+ { Tenum ($2, None, []), $1 }
+| ENUM id_or_typename LBRACE enum_list maybecomma RBRACE
+ { Tenum ($2, Some $4, []), $1 }
+| ENUM LBRACE enum_list maybecomma RBRACE
+ { Tenum ("", Some $3, []), $1 }
+| ENUM just_attributes id_or_typename LBRACE enum_list maybecomma RBRACE
+ { Tenum ($3, Some $5, $2), $1 }
+| ENUM just_attributes LBRACE enum_list maybecomma RBRACE
+ { Tenum ("", Some $4, $2), $1 }
+| NAMED_TYPE { Tnamed (fst $1), snd $1 }
+| TYPEOF LPAREN expression RPAREN { TtypeofE (fst $3), $1 }
+| TYPEOF LPAREN type_name RPAREN { let s, d = $3 in
+ TtypeofT (s, d), $1 }
+;
+struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
+ * also allow missing field names. *)
+ */
+ /* empty */ { [] }
+| decl_spec_list SEMICOLON struct_decl_list
+ { (fst $1,
+ [(missingFieldDecl, None)]) :: $3 }
+/*(* GCC allows extra semicolons *)*/
+| SEMICOLON struct_decl_list
+ { $2 }
+| decl_spec_list field_decl_list SEMICOLON struct_decl_list
+ { (fst $1, $2)
+ :: $4 }
+/*(* MSVC allows pragmas in strange places *)*/
+| pragma struct_decl_list { $2 }
+
+| error SEMICOLON struct_decl_list
+ { $3 }
+;
+field_decl_list: /* (* ISO 6.7.2 *) */
+ field_decl { [$1] }
+| field_decl COMMA field_decl_list { $1 :: $3 }
+;
+field_decl: /* (* ISO 6.7.2. Except that we allow unnamed fields. *) */
+| declarator { ($1, None) }
+| declarator COLON expression attributes
+ { let (n,decl,al,loc) = $1 in
+ let al' = al @ $4 in
+ ((n,decl,al',loc), Some (fst $3)) }
+| COLON expression { (missingFieldDecl, Some (fst $2)) }
+;
+
+enum_list: /* (* ISO 6.7.2.2 *) */
+ enumerator {[$1]}
+| enum_list COMMA enumerator {$1 @ [$3]}
+| enum_list COMMA error { $1 }
+;
+enumerator:
+ IDENT {(fst $1, NOTHING, snd $1)}
+| IDENT EQ expression {(fst $1, fst $3, snd $1)}
+;
+
+
+declarator: /* (* ISO 6.7.5. Plus Microsoft declarators.*) */
+ pointer_opt direct_decl attributes_with_asm
+ { let (n, decl) = $2 in
+ (n, applyPointer (fst $1) decl, $3, (snd $1)) }
+;
+
+
+direct_decl: /* (* ISO 6.7.5 *) */
+ /* (* We want to be able to redefine named
+ * types as variable names *) */
+| id_or_typename { ($1, JUSTBASE) }
+
+| LPAREN attributes declarator RPAREN
+ { let (n,decl,al,loc) = $3 in
+ (n, PARENTYPE($2,decl,al)) }
+
+| direct_decl LBRACKET attributes comma_expression_opt RBRACKET
+ { let (n, decl) = $1 in
+ (n, ARRAY(decl, $3, $4)) }
+| direct_decl LBRACKET attributes error RBRACKET
+ { let (n, decl) = $1 in
+ (n, ARRAY(decl, $3, NOTHING)) }
+| direct_decl parameter_list_startscope rest_par_list RPAREN
+ { let (n, decl) = $1 in
+ let (params, isva) = $3 in
+ !pop_context ();
+ (n, PROTO(decl, params, isva))
+ }
+;
+parameter_list_startscope:
+ LPAREN { !push_context () }
+;
+rest_par_list:
+| /* empty */ { ([], false) }
+| parameter_decl rest_par_list1 { let (params, isva) = $2 in
+ ($1 :: params, isva)
+ }
+;
+rest_par_list1:
+ /* empty */ { ([], false) }
+| COMMA ELLIPSIS { ([], true) }
+| COMMA parameter_decl rest_par_list1 { let (params, isva) = $3 in
+ ($2 :: params, isva)
+ }
+;
+
+
+parameter_decl: /* (* ISO 6.7.5 *) */
+ decl_spec_list declarator { (fst $1, $2) }
+| decl_spec_list abstract_decl { let d, a = $2 in
+ (fst $1, ("", d, a, cabslu)) }
+| decl_spec_list { (fst $1, ("", JUSTBASE, [], cabslu)) }
+| LPAREN parameter_decl RPAREN { $2 }
+;
+
+/* (* Old style prototypes. Like a declarator *) */
+old_proto_decl:
+ pointer_opt direct_old_proto_decl { let (n, decl, a) = $2 in
+ (n, applyPointer (fst $1) decl,
+ a, snd $1)
+ }
+
+;
+
+direct_old_proto_decl:
+ direct_decl LPAREN old_parameter_list_ne RPAREN old_pardef_list
+ { let par_decl, isva = doOldParDecl $3 $5 in
+ let n, decl = $1 in
+ (n, PROTO(decl, par_decl, isva), [])
+ }
+| direct_decl LPAREN RPAREN
+ { let n, decl = $1 in
+ (n, PROTO(decl, [], false), [])
+ }
+
+/* (* appears sometimesm but generates a shift-reduce conflict. *)
+| LPAREN STAR direct_decl LPAREN old_parameter_list_ne RPAREN RPAREN LPAREN RPAREN old_pardef_list
+ { let par_decl, isva
+ = doOldParDecl $5 $10 in
+ let n, decl = $3 in
+ (n, PROTO(decl, par_decl, isva), [])
+ }
+*/
+;
+
+old_parameter_list_ne:
+| IDENT { [fst $1] }
+| IDENT COMMA old_parameter_list_ne { let rest = $3 in
+ (fst $1 :: rest) }
+;
+
+old_pardef_list:
+ /* empty */ { ([], false) }
+| decl_spec_list old_pardef SEMICOLON ELLIPSIS
+ { ([(fst $1, $2)], true) }
+| decl_spec_list old_pardef SEMICOLON old_pardef_list
+ { let rest, isva = $4 in
+ ((fst $1, $2) :: rest, isva)
+ }
+;
+
+old_pardef:
+ declarator { [$1] }
+| declarator COMMA old_pardef { $1 :: $3 }
+| error { [] }
+;
+
+
+pointer: /* (* ISO 6.7.5 *) */
+ STAR attributes pointer_opt { $2 :: fst $3, $1 }
+;
+pointer_opt:
+ /**/ { let l = currentLoc () in
+ ([], l) }
+| pointer { $1 }
+;
+
+type_name: /* (* ISO 6.7.6 *) */
+ decl_spec_list abstract_decl { let d, a = $2 in
+ if a <> [] then begin
+ parse_error "attributes in type name";
+ raise Parsing.Parse_error
+ end;
+ (fst $1, d)
+ }
+| decl_spec_list { (fst $1, JUSTBASE) }
+;
+abstract_decl: /* (* ISO 6.7.6. *) */
+ pointer_opt abs_direct_decl attributes { applyPointer (fst $1) $2, $3 }
+| pointer { applyPointer (fst $1) JUSTBASE, [] }
+;
+
+abs_direct_decl: /* (* ISO 6.7.6. We do not support optional declarator for
+ * functions. Plus Microsoft attributes. See the
+ * discussion for declarator. *) */
+| LPAREN attributes abstract_decl RPAREN
+ { let d, a = $3 in
+ PARENTYPE ($2, d, a)
+ }
+
+| LPAREN error RPAREN
+ { JUSTBASE }
+
+| abs_direct_decl_opt LBRACKET comma_expression_opt RBRACKET
+ { ARRAY($1, [], $3) }
+/*(* The next should be abs_direct_decl_opt but we get conflicts *)*/
+| abs_direct_decl parameter_list_startscope rest_par_list RPAREN
+ { let (params, isva) = $3 in
+ !pop_context ();
+ PROTO ($1, params, isva)
+ }
+;
+abs_direct_decl_opt:
+ abs_direct_decl { $1 }
+| /* empty */ { JUSTBASE }
+;
+function_def: /* (* ISO 6.9.1 *) */
+ function_def_start block
+ { let (loc, specs, decl) = $1 in
+ currentFunctionName := "<__FUNCTION__ used outside any functions>";
+ !pop_context (); (* The context pushed by
+ * announceFunctionName *)
+ doFunctionDef ((*handleLoc*) loc) (trd3 $2) specs decl (fst3 $2)
+ }
+
+
+function_def_start: /* (* ISO 6.9.1 *) */
+ decl_spec_list declarator
+ { announceFunctionName $2;
+ (snd $1, fst $1, $2)
+ }
+
+/* (* Old-style function prototype *) */
+| decl_spec_list old_proto_decl
+ { announceFunctionName $2;
+ (snd $1, fst $1, $2)
+ }
+/* (* New-style function that does not have a return type *) */
+| IDENT parameter_list_startscope rest_par_list RPAREN
+ { let (params, isva) = $3 in
+ let fdec =
+ (fst $1, PROTO(JUSTBASE, params, isva), [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+
+/* (* No return type and old-style parameter list *) */
+| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list
+ { (* Convert pardecl to new style *)
+ let pardecl, isva = doOldParDecl $3 $5 in
+ (* Make the function declarator *)
+ let fdec = (fst $1,
+ PROTO(JUSTBASE, pardecl,isva),
+ [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+/* (* No return type and no parameters *) */
+| IDENT LPAREN RPAREN
+ { (* Make the function declarator *)
+ let fdec = (fst $1,
+ PROTO(JUSTBASE, [], false),
+ [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+;
+
+/* const/volatile as type specifier elements */
+cvspec:
+ CONST { SpecCV(CV_CONST), $1 }
+| VOLATILE { SpecCV(CV_VOLATILE), $1 }
+| RESTRICT { SpecCV(CV_RESTRICT), $1 }
+;
+
+/*** GCC attributes ***/
+attributes:
+ /* empty */ { []}
+| attribute attributes { fst $1 :: $2 }
+;
+
+/* (* In some contexts we can have an inline assembly to specify the name to
+ * be used for a global. We treat this as a name attribute *) */
+attributes_with_asm:
+ /* empty */ { [] }
+| attribute attributes_with_asm { fst $1 :: $2 }
+| ASM LPAREN string_constant RPAREN attributes
+ { ("__asm__",
+ [CONSTANT(CONST_STRING (fst $3))]) :: $5 }
+;
+
+/* things like __attribute__, but no const/volatile */
+attribute_nocv:
+ ATTRIBUTE LPAREN paren_attr_list RPAREN
+ { ("__attribute__", $3), $1 }
+/*(*
+| ATTRIBUTE_USED { ("__attribute__",
+ [ VARIABLE "used" ]), $1 }
+*)*/
+| DECLSPEC paren_attr_list_ne { ("__declspec", $2), $1 }
+| MSATTR { (fst $1, []), snd $1 }
+ /* ISO 6.7.3 */
+| THREAD { ("__thread",[]), $1 }
+;
+
+attribute_nocv_list:
+ /* empty */ { []}
+| attribute_nocv attribute_nocv_list { fst $1 :: $2 }
+;
+
+/* __attribute__ plus const/volatile */
+attribute:
+ attribute_nocv { $1 }
+| CONST { ("const", []), $1 }
+| RESTRICT { ("restrict",[]), $1 }
+| VOLATILE { ("volatile",[]), $1 }
+;
+
+/* (* sm: I need something that just includes __attribute__ and nothing more,
+ * to support them appearing between the 'struct' keyword and the type name.
+ * Actually, a declspec can appear there as well (on MSVC) *) */
+just_attribute:
+ ATTRIBUTE LPAREN paren_attr_list RPAREN
+ { ("__attribute__", $3) }
+| DECLSPEC paren_attr_list_ne { ("__declspec", $2) }
+;
+
+/* this can't be empty, b/c I folded that possibility into the calling
+ * productions to avoid some S/R conflicts */
+just_attributes:
+ just_attribute { [$1] }
+| just_attribute just_attributes { $1 :: $2 }
+;
+
+/** (* PRAGMAS and ATTRIBUTES *) ***/
+pragma:
+| PRAGMA_LINE { PRAGMA (fst $1, snd $1) }
+;
+
+/* (* We want to allow certain strange things that occur in pragmas, so we
+ * cannot use directly the language of expressions *) */
+primary_attr:
+ IDENT { VARIABLE (fst $1) }
+ /*(* The NAMED_TYPE here creates conflicts with IDENT *)*/
+| NAMED_TYPE { VARIABLE (fst $1) }
+| LPAREN attr RPAREN { $2 }
+| IDENT IDENT { CALL(VARIABLE (fst $1), [VARIABLE (fst $2)]) }
+| CST_INT { CONSTANT(CONST_INT (fst $1)) }
+| string_constant { CONSTANT(CONST_STRING (fst $1)) }
+ /*(* Const when it appears in
+ * attribute lists, is translated
+ * to aconst *)*/
+| CONST { VARIABLE "aconst" }
+
+| IDENT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
+
+/*(* The following rule conflicts with the ? : attributes. We give it a very
+ * low priority *)*/
+| CST_INT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
+
+| DEFAULT COLON CST_INT { VARIABLE ("default:" ^ fst $3) }
+
+ /*(** GCC allows this as an
+ * attribute for functions,
+ * synonim for noreturn **)*/
+| VOLATILE { VARIABLE ("__noreturn__") }
+;
+
+postfix_attr:
+ primary_attr { $1 }
+ /* (* use a VARIABLE "" so that the
+ * parentheses are printed *) */
+| IDENT LPAREN RPAREN { CALL(VARIABLE (fst $1), [VARIABLE ""]) }
+| IDENT paren_attr_list_ne { CALL(VARIABLE (fst $1), $2) }
+
+| postfix_attr ARROW id_or_typename {MEMBEROFPTR ($1, $3)}
+| postfix_attr DOT id_or_typename {MEMBEROF ($1, $3)}
+| postfix_attr LBRACKET attr RBRACKET {INDEX ($1, $3) }
+;
+
+/*(* Since in attributes we use both IDENT and NAMED_TYPE as indentifiers,
+ * that leads to conflicts for SIZEOF and ALIGNOF. In those cases we require
+ * that their arguments be expressions, not attributes *)*/
+unary_attr:
+ postfix_attr { $1 }
+| SIZEOF unary_expression {EXPR_SIZEOF (fst $2) }
+| SIZEOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_SIZEOF (b, d)}
+
+| ALIGNOF unary_expression {EXPR_ALIGNOF (fst $2) }
+| ALIGNOF LPAREN type_name RPAREN {let b, d = $3 in TYPE_ALIGNOF (b, d)}
+| PLUS cast_attr {UNARY (PLUS, $2)}
+| MINUS cast_attr {UNARY (MINUS, $2)}
+| STAR cast_attr {UNARY (MEMOF, $2)}
+| AND cast_attr
+ {UNARY (ADDROF, $2)}
+| EXCLAM cast_attr {UNARY (NOT, $2)}
+| TILDE cast_attr {UNARY (BNOT, $2)}
+;
+
+cast_attr:
+ unary_attr { $1 }
+;
+
+multiplicative_attr:
+ cast_attr { $1 }
+| multiplicative_attr STAR cast_attr {BINARY(MUL ,$1 , $3)}
+| multiplicative_attr SLASH cast_attr {BINARY(DIV ,$1 , $3)}
+| multiplicative_attr PERCENT cast_attr {BINARY(MOD ,$1 , $3)}
+;
+
+
+additive_attr:
+ multiplicative_attr { $1 }
+| additive_attr PLUS multiplicative_attr {BINARY(ADD ,$1 , $3)}
+| additive_attr MINUS multiplicative_attr {BINARY(SUB ,$1 , $3)}
+;
+
+shift_attr:
+ additive_attr { $1 }
+| shift_attr INF_INF additive_attr {BINARY(SHL ,$1 , $3)}
+| shift_attr SUP_SUP additive_attr {BINARY(SHR ,$1 , $3)}
+;
+
+relational_attr:
+ shift_attr { $1 }
+| relational_attr INF shift_attr {BINARY(LT ,$1 , $3)}
+| relational_attr SUP shift_attr {BINARY(GT ,$1 , $3)}
+| relational_attr INF_EQ shift_attr {BINARY(LE ,$1 , $3)}
+| relational_attr SUP_EQ shift_attr {BINARY(GE ,$1 , $3)}
+;
+
+equality_attr:
+ relational_attr { $1 }
+| equality_attr EQ_EQ relational_attr {BINARY(EQ ,$1 , $3)}
+| equality_attr EXCLAM_EQ relational_attr {BINARY(NE ,$1 , $3)}
+;
+
+
+bitwise_and_attr:
+ equality_attr { $1 }
+| bitwise_and_attr AND equality_attr {BINARY(BAND ,$1 , $3)}
+;
+
+bitwise_xor_attr:
+ bitwise_and_attr { $1 }
+| bitwise_xor_attr CIRC bitwise_and_attr {BINARY(XOR ,$1 , $3)}
+;
+
+bitwise_or_attr:
+ bitwise_xor_attr { $1 }
+| bitwise_or_attr PIPE bitwise_xor_attr {BINARY(BOR ,$1 , $3)}
+;
+
+logical_and_attr:
+ bitwise_or_attr { $1 }
+| logical_and_attr AND_AND bitwise_or_attr {BINARY(AND ,$1 , $3)}
+;
+
+logical_or_attr:
+ logical_and_attr { $1 }
+| logical_or_attr PIPE_PIPE logical_and_attr {BINARY(OR ,$1 , $3)}
+;
+
+conditional_attr:
+ logical_or_attr { $1 }
+/* This is in conflict for now */
+| logical_or_attr QUEST conditional_attr COLON conditional_attr
+ { QUESTION($1, $3, $5) }
+
+
+attr: conditional_attr { $1 }
+;
+
+attr_list_ne:
+| attr { [$1] }
+| attr COMMA attr_list_ne { $1 :: $3 }
+| error COMMA attr_list_ne { $3 }
+;
+attr_list:
+ /* empty */ { [] }
+| attr_list_ne { $1 }
+;
+paren_attr_list_ne:
+ LPAREN attr_list_ne RPAREN { $2 }
+| LPAREN error RPAREN { [] }
+;
+paren_attr_list:
+ LPAREN attr_list RPAREN { $2 }
+| LPAREN error RPAREN { [] }
+;
+/*** GCC ASM instructions ***/
+asmattr:
+ /* empty */ { [] }
+| VOLATILE asmattr { ("volatile", []) :: $2 }
+| CONST asmattr { ("const", []) :: $2 }
+;
+asmtemplate:
+ one_string_constant { [$1] }
+| one_string_constant asmtemplate { $1 :: $2 }
+;
+asmoutputs:
+ /* empty */ { None }
+| COLON asmoperands asminputs
+ { let (ins, clobs) = $3 in
+ Some {aoutputs = $2; ainputs = ins; aclobbers = clobs} }
+;
+asmoperands:
+ /* empty */ { [] }
+| asmoperandsne { List.rev $1 }
+;
+asmoperandsne:
+ asmoperand { [$1] }
+| asmoperandsne COMMA asmoperand { $3 :: $1 }
+;
+asmoperand:
+ asmopname string_constant LPAREN expression RPAREN { ($1, fst $2, fst $4) }
+| asmopname string_constant LPAREN error RPAREN { ($1, fst $2, NOTHING ) }
+;
+asminputs:
+ /* empty */ { ([], []) }
+| COLON asmoperands asmclobber
+ { ($2, $3) }
+;
+asmopname:
+ /* empty */ { None }
+| LBRACKET IDENT RBRACKET { Some (fst $2) }
+;
+
+asmclobber:
+ /* empty */ { [] }
+| COLON asmcloberlst_ne { $2 }
+;
+asmcloberlst_ne:
+ one_string_constant { [$1] }
+| one_string_constant COMMA asmcloberlst_ne { $1 :: $3 }
+;
+
+%%
+
+
+
projects / pkg-cerco / acc-trusted.git / blobdiff