path: root/cparser/Parser.mly

/*(*
 *
 * 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 <Cabs.floatInfo * 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 ALIGNAS

%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 PACKED
%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 }
*)*/
|   ALIGNAS paren_comma_expression
          { ("_Alignas", [smooth_expression(fst $2)]), $1 }
|   ALIGNAS LPAREN type_name RPAREN
          { let (b, d) = $3 in
            ("_Alignas", [TYPE_ALIGNOF(b, d)]), $1 }
|   PACKED LPAREN attr_list RPAREN      { ("__packed__", $3), $1 }
|   PACKED                              { ("__packed__", []), $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).
 * XL: ... and so does _Alignas(). *)  */
just_attribute:
    ATTRIBUTE LPAREN paren_attr_list RPAREN
                                        { ("__attribute__", $3) }
|   ALIGNAS paren_comma_expression
          { ("_Alignas", [smooth_expression(fst $2)]) }
|   ALIGNAS LPAREN type_name RPAREN
          { let (b, d) = $3 in ("_Alignas", [TYPE_ALIGNOF(b, d)]) }
|   PACKED LPAREN attr_list RPAREN      { ("__packed__", $3) }
|   PACKED                              { ("__packed__", []) }
|   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 }
;
  
%%