%{
-(* Copyright (C) 2002, 2006, 2007, 2008 Yoann Padioleau
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2002, 2006, 2007, 2008, 2009 Yoann Padioleau
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License (GPL)
* version 2 as published by the Free Software Foundation.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
open Semantic_c (* Semantic exn *)
-module Stat = Parsing_stat
(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
-let warning s v =
- if !Flag_parsing_c.verbose_parsing
+let warning s v =
+ if !Flag_parsing_c.verbose_parsing
then Common.warning ("PARSING: " ^ s) v
else v
-
-let pr2 s =
- if !Flag_parsing_c.verbose_parsing
- then Common.pr2 s
+let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing
(*****************************************************************************)
(* Parse helpers functions *)
type shortLong = Short | Long | LongLong
-type decl = {
+type decl = {
storageD: storagebis wrap;
typeD: ((sign option) * (shortLong option) * (typeCbis option)) wrap;
qualifD: typeQualifierbis wrap;
(* note: have a full_info: parse_info list; to remember ordering
* between storage, qualifier, type ? well this info is already in
* the Ast_c.info, just have to sort them to get good order *)
-}
+}
let nullDecl = {
storageD = NoSto, [];
}
let fake_pi = Common.fake_parse_info
-let addStorageD = function
+let addStorageD = function
| ((x,ii), ({storageD = (NoSto,[])} as v)) -> { v with storageD = (x, [ii]) }
- | ((x,ii), ({storageD = (y, ii2)} as v)) ->
- if x = y then warning "duplicate storage classes" v
+ | ((x,ii), ({storageD = (y, ii2)} as v)) ->
+ if x =*= y then warning "duplicate storage classes" v
else raise (Semantic ("multiple storage classes", fake_pi))
-let addInlineD = function
+let addInlineD = function
| ((true,ii), ({inlineD = (false,[])} as v)) -> { v with inlineD=(true,[ii])}
| ((true,ii), ({inlineD = (true, ii2)} as v)) -> warning "duplicate inline" v
- | _ -> raise Impossible
+ | _ -> raise (Impossible 86)
-let addTypeD = function
- | ((Left3 Signed,ii) ,({typeD = ((Some Signed, b,c),ii2)} as v)) ->
+let addTypeD = function
+ | ((Left3 Signed,ii) ,({typeD = ((Some Signed, b,c),ii2)} as v)) ->
warning "duplicate 'signed'" v
- | ((Left3 UnSigned,ii) ,({typeD = ((Some UnSigned,b,c),ii2)} as v)) ->
+ | ((Left3 UnSigned,ii) ,({typeD = ((Some UnSigned,b,c),ii2)} as v)) ->
warning "duplicate 'unsigned'" v
- | ((Left3 _,ii), ({typeD = ((Some _,b,c),ii2)} as _v)) ->
+ | ((Left3 _,ii), ({typeD = ((Some _,b,c),ii2)} as _v)) ->
raise (Semantic ("both signed and unsigned specified", fake_pi))
- | ((Left3 x,ii), ({typeD = ((None,b,c),ii2)} as v)) ->
+ | ((Left3 x,ii), ({typeD = ((None,b,c),ii2)} as v)) ->
{v with typeD = (Some x,b,c),ii ++ ii2}
- | ((Middle3 Short,ii), ({typeD = ((a,Some Short,c),ii2)} as v)) ->
+ | ((Middle3 Short,ii), ({typeD = ((a,Some Short,c),ii2)} as v)) ->
warning "duplicate 'short'" v
-
+
(* gccext: long long allowed *)
- | ((Middle3 Long,ii), ({typeD = ((a,Some Long ,c),ii2)} as v)) ->
+ | ((Middle3 Long,ii), ({typeD = ((a,Some Long ,c),ii2)} as v)) ->
{ v with typeD = (a, Some LongLong, c),ii++ii2 }
- | ((Middle3 Long,ii), ({typeD = ((a,Some LongLong ,c),ii2)} as v)) ->
+ | ((Middle3 Long,ii), ({typeD = ((a,Some LongLong ,c),ii2)} as v)) ->
warning "triplicate 'long'" v
- | ((Middle3 _,ii), ({typeD = ((a,Some _,c),ii2)} as _v)) ->
+ | ((Middle3 _,ii), ({typeD = ((a,Some _,c),ii2)} as _v)) ->
raise (Semantic ("both long and short specified", fake_pi))
- | ((Middle3 x,ii), ({typeD = ((a,None,c),ii2)} as v)) ->
+ | ((Middle3 x,ii), ({typeD = ((a,None,c),ii2)} as v)) ->
{v with typeD = (a, Some x,c),ii++ii2}
- | ((Right3 t,ii), ({typeD = ((a,b,Some _),ii2)} as _v)) ->
- raise (Semantic ("two or more data types", fake_pi))
- | ((Right3 t,ii), ({typeD = ((a,b,None),ii2)} as v)) ->
+ | ((Right3 t,ii), ({typeD = ((a,b,Some x),ii2)} as _v)) ->
+ raise (Semantic ((Printf.sprintf "two or more data types: t %s ii %s\ntypeD %s ii2 %s\n" (Dumper.dump t) (Dumper.dump ii) (Dumper.dump x) (Dumper.dump ii2)), fake_pi))
+ | ((Right3 t,ii), ({typeD = ((a,b,None),ii2)} as v)) ->
{v with typeD = (a,b, Some t),ii++ii2}
| ({volatile=true},({volatile=true} as x))-> warning "duplicate 'volatile'" x
| ({const=true}, v) -> {v with const=true}
| ({volatile=true}, v) -> {v with volatile=true}
- | _ ->
+ | _ ->
internal_error "there is no noconst or novolatile keyword"
let addQualifD ((qu,ii), ({qualifD = (v,ii2)} as x)) =
(* stdC: type section, basic integer types (and ritchie)
- * To understand the code, just look at the result (right part of the PM)
+ * To understand the code, just look at the result (right part of the PM)
* and go back.
*)
let (fixDeclSpecForDecl: decl -> (fullType * (storage wrap))) = function
- {storageD = (st,iist);
- qualifD = (qu,iiq);
- typeD = (ty,iit);
+ {storageD = (st,iist);
+ qualifD = (qu,iiq);
+ typeD = (ty,iit);
inlineD = (inline,iinl);
- } ->
- (
- ((qu, iiq),
- (match ty with
- | (None,None,None) ->
- (* generate fake_info, otherwise type_annotater can crash in
+ } ->
+ let ty',iit' =
+ (match ty with
+ | (None,None,None) ->
+ (* generate fake_info, otherwise type_annotater can crash in
* offset.
*)
warning "type defaults to 'int'" (defaultInt, [fakeInfo fake_pi])
| (None, None, Some t) -> (t, iit)
-
- | (Some sign, None, (None| Some (BaseType (IntType (Si (_,CInt)))))) ->
+
+ | (Some sign, None, (None| Some (BaseType (IntType (Si (_,CInt)))))) ->
BaseType(IntType (Si (sign, CInt))), iit
- | ((None|Some Signed),Some x,(None|Some(BaseType(IntType (Si (_,CInt)))))) ->
+ | ((None|Some Signed),Some x,(None|Some(BaseType(IntType (Si (_,CInt)))))) ->
BaseType(IntType (Si (Signed, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
- | (Some UnSigned, Some x, (None| Some (BaseType (IntType (Si (_,CInt))))))->
+ | (Some UnSigned, Some x, (None| Some (BaseType (IntType (Si (_,CInt))))))->
BaseType(IntType (Si (UnSigned, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
- | (Some sign, None, (Some (BaseType (IntType CChar)))) -> BaseType(IntType (Si (sign, CChar2))), iit
- | (None, Some Long,(Some(BaseType(FloatType CDouble)))) -> BaseType (FloatType (CLongDouble)), iit
+ | (Some sign, None, (Some (BaseType (IntType CChar)))) ->
+ BaseType(IntType (Si (sign, CChar2))), iit
+ | (None, Some Long,(Some(BaseType(FloatType CDouble)))) ->
+ BaseType (FloatType (CLongDouble)), iit
- | (Some _,_, Some _) ->
+ | (Some _,_, Some _) ->
(*mine*)
raise (Semantic ("signed, unsigned valid only for char and int", fake_pi))
- | (_,Some _,(Some(BaseType(FloatType (CFloat|CLongDouble))))) ->
+ | (_,Some _,(Some(BaseType(FloatType (CFloat|CLongDouble))))) ->
raise (Semantic ("long or short specified with floatint type", fake_pi))
| (_,Some Short,(Some(BaseType(FloatType CDouble)))) ->
raise (Semantic ("the only valid combination is long double", fake_pi))
-
- | (_, Some _, Some _) ->
+
+ | (_, Some _, Some _) ->
(* mine *)
- raise (Semantic ("long, short valid only for int or float", fake_pi))
+ raise (Semantic ("long, short valid only for int or float", fake_pi))
(* if do short uint i, then gcc say parse error, strange ? it is
* not a parse error, it is just that we dont allow with typedef
* {....} and never with a typedef cos now we parse short uint i
* as short ident ident => parse error (cos after first short i
* pass in dt() mode) *)
- ))
+
+ )
+ in
+ ((qu, iiq),
+ (ty', iit'))
,((st, inline),iist++iinl)
- )
-let fixDeclSpecForParam = function ({storageD = (st,iist)} as r) ->
+
+let fixDeclSpecForParam = function ({storageD = (st,iist)} as r) ->
let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in
match st with
| (Sto Register) -> (v, true), iist
| NoSto -> (v, false), iist
- | _ ->
- raise
- (Semantic ("storage class specified for parameter of function",
+ | _ ->
+ raise
+ (Semantic ("storage class specified for parameter of function",
fake_pi))
+let fixDeclSpecForMacro = function ({storageD = (st,iist)} as r) ->
+ let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in
+ match st with
+ | NoSto -> v
+ | _ ->
+ raise
+ (Semantic ("storage class specified for macro type decl",
+ fake_pi))
+
+
let fixDeclSpecForFuncDef x =
let (returnType,storage) = fixDeclSpecForDecl x in
(match fst (unwrap storage) with
- | StoTypedef ->
+ | StoTypedef ->
raise (Semantic ("function definition declared 'typedef'", fake_pi))
- | x -> (returnType, storage)
+ | _ -> (returnType, storage)
)
+
(* parameter: (this is the context where we give parameter only when
* in func DEFINITION not in funct DECLARATION) We must have a name.
* This function ensure that we give only parameterTypeDecl with well
* argument (in the typedef)
*)
let (fixOldCDecl: fullType -> fullType) = fun ty ->
- match snd ty with
- | ((FunctionType (fullt, (params, (b, iib)))),iifunc) ->
+ match Ast_c.unwrap_typeC ty with
+ | FunctionType (fullt, (params, (b, iib))) ->
(* stdC: If the prototype declaration declares a parameter for a
* function that you are defining (it is part of a function
* definition), then you must write a name within the declarator.
* Otherwise, you can omit the name. *)
(match params with
- | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] ->
- ty
- | params ->
- (params +> List.iter (function
- | (((b, None, _), ii1),ii2) ->
+ | [{p_namei = None; p_type = ty2},_] ->
+ (match Ast_c.unwrap_typeC ty2 with
+ | BaseType Void ->
+ ty
+ | _ ->
+ pr2_once ("SEMANTIC:parameter name omitted, but I continue");
+ ty
+ )
+
+ | params ->
+ (params +> List.iter (fun (param,_) ->
+ match param with
+ | {p_namei = None} ->
(* if majuscule, then certainly macro-parameter *)
- pr2 ("SEMANTIC:parameter name omitted, but I continue");
- | _ -> ()
- );
- ty)
+ pr2_once ("SEMANTIC:parameter name omitted, but I continue");
+ | _ -> ()
+ ));
+ ty
)
+
(* todo? can we declare prototype in the decl or structdef,
... => length <> but good kan meme *)
- | _ ->
+ | _ ->
(* gcc say parse error but dont see why *)
- raise (Semantic ("seems this is not a function", fake_pi))
+ raise (Semantic ("seems this is not a function", fake_pi))
-let fixFunc (typ, compound, old_style_opt) =
+let fixFunc (typ, compound, old_style_opt) =
let (cp,iicp) = compound in
- match typ with
- | ((s,iis),
- (nQ, (FunctionType (fullt, (params,bool)),iifunc)),
- (st,iist),
- attrs)
- ->
+ let (name, ty, (st,iist), attrs) = typ in
+
+ let (qu, tybis) = ty in
+
+ match Ast_c.unwrap_typeC ty with
+ | FunctionType (fullt, (params,abool)) ->
+ let iifunc = Ast_c.get_ii_typeC_take_care tybis in
+
let iistart = Ast_c.fakeInfo () in
- assert (nQ =*= nullQualif);
+ assert (qu =*= nullQualif);
+
(match params with
- | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] -> ()
- | params ->
- params +> List.iter (function
- | (((bool, Some s, fullt), _), _) -> ()
+ | [{p_namei= None; p_type = ty2}, _] ->
+ (match Ast_c.unwrap_typeC ty2 with
+ | BaseType Void -> ()
+ | _ ->
+ (* failwith "internal errror: fixOldCDecl not good" *)
+ ()
+ )
+ | params ->
+ params +> List.iter (function
+ | ({p_namei = Some s}, _) -> ()
| _ -> ()
(* failwith "internal errror: fixOldCDecl not good" *)
- ));
+ )
+ );
+ (* bugfix: cf tests_c/function_pointer4.c.
+ * Apparemment en C on peut syntaxiquement ecrire ca:
+ *
+ * void a(int)(int x);
+ * mais apres gcc gueule au niveau semantique avec:
+ * xxx.c:1: error: 'a' declared as function returning a function
+ * Je ne faisais pas cette verif. Sur du code comme
+ * void METH(foo)(int x) { ...} , le parser croit (a tort) que foo
+ * est un typedef, et donc c'est parsé comme l'exemple precedent,
+ * ce qui ensuite confuse l'unparser qui n'est pas habitué
+ * a avoir dans le returnType un FunctionType et qui donc
+ * pr_elem les ii dans le mauvais sens ce qui genere au final
+ * une exception. Hence this fix to at least detect the error
+ * at parsing time (not unparsing time).
+ *)
+ (match Ast_c.unwrap_typeC fullt with
+ | FunctionType _ ->
+ let s = Ast_c.str_of_name name in
+ let iis = Ast_c.info_of_name name in
+ pr2 (spf "WEIRD: %s declared as function returning a function." s);
+ pr2 (spf "This is probably because of a macro. Extend standard.h");
+ raise (Semantic (spf "error: %s " s, Ast_c.parse_info_of_info iis))
+ | _ -> ()
+ );
+
(* it must be nullQualif,cos parser construct only this*)
- {f_name = s;
- f_type = (fullt, (params, bool));
+ {f_name = name;
+ f_type = (fullt, (params, abool));
f_storage = st;
f_body = cp;
f_attr = attrs;
f_old_c_style = old_style_opt;
- },
- ([iis]++iifunc++iicp++[iistart]++iist)
- | _ ->
- raise
- (Semantic
+ },
+ (iifunc++iicp++[iistart]++iist)
+ | _ ->
+ raise
+ (Semantic
("you are trying to do a function definition but you dont give " ^
"any parameter", fake_pi))
(* parse_typedef_fix2 *)
(*-------------------------------------------------------------------------- *)
-let dt s () =
- if !Flag_parsing_c.debug_etdt then pr2 ("<" ^ s);
+let dt s () =
+ if !Flag_parsing_c.debug_etdt then pr2 ("<" ^ s);
LP.disable_typedef ()
-let et s () =
- if !Flag_parsing_c.debug_etdt then pr2 (">" ^ s);
+let et s () =
+ if !Flag_parsing_c.debug_etdt then pr2 (">" ^ s);
LP.enable_typedef ()
-let fix_add_params_ident = function
- | ((s, (nQ, (FunctionType (fullt, (params, bool)),_)), st, _attrs)) ->
+let fix_add_params_ident x =
+ let (s, ty, st, _attrs) = x in
+ match Ast_c.unwrap_typeC ty with
+ | FunctionType (fullt, (params, bool)) ->
(match params with
- | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] -> ()
- | params ->
- params +> List.iter (function
- | (((bool, Some s, fullt), _), _) ->
- LP.add_ident s
- | _ ->
- ()
- (* failwith "internal errror: fixOldCDecl not good" *)
- ))
+ | [{p_namei=None; p_type=ty2}, _] ->
+ (match Ast_c.unwrap_typeC ty2 with
+ | BaseType Void -> ()
+ | _ ->
+ (* failwith "internal errror: fixOldCDecl not good" *)
+ ()
+ )
+ | params ->
+ params +> List.iter (function
+ | ({p_namei= Some name}, _) ->
+ LP.add_ident (Ast_c.str_of_name s)
+ | _ ->
+ ()
+ (* failwith "internal errror: fixOldCDecl not good" *)
+ )
+ )
| _ -> ()
+
+
(*-------------------------------------------------------------------------- *)
(* shortcuts *)
(*-------------------------------------------------------------------------- *)
-let mk_e e ii = ((e, Ast_c.noType()), ii)
-
+let mk_e e ii = Ast_c.mk_e e ii
+
+let mk_string_wrap (s,info) = (s, [info])
+
%}
/*(*****************************************************************************)*/
/*(*************************************************************************)*/
/*
-(*
+(*
* Some tokens are not even used in this file because they are filtered
* in some intermediate phase. But they still must be declared because
* ocamllex may generate them, or some intermediate phase may also
/*(* the normal tokens *)*/
/*(*-----------------------------------------*)*/
-%token <string * Ast_c.info> TInt
+%token <(string * (Ast_c.sign * Ast_c.base)) * Ast_c.info> TInt
%token <(string * Ast_c.floatType) * Ast_c.info> TFloat
%token <(string * Ast_c.isWchar) * Ast_c.info> TChar
%token <(string * Ast_c.isWchar) * Ast_c.info> TString
-%token <string * Ast_c.info> TIdent
+%token <string * Ast_c.info> TIdent
+%token <string * Ast_c.info> TKRParam
+%token <string * Ast_c.info> Tconstructorname /* parsing_hack for c++ */
/*(* appears mostly after some fix_xxx in parsing_hack *)*/
%token <string * Ast_c.info> TypedefIdent
/*
-(* Some tokens like TOPar and TCPar are used as synchronisation stuff,
+(* Some tokens like TOPar and TCPar are used as synchronisation stuff,
* in parsing_hack.ml. So if define special tokens like TOParDefine and
* TCParEOL, then take care to also modify in Token_helpers.
*)
*/
-
-%token <Ast_c.info> TOPar TCPar TOBrace TCBrace TOCro TCCro
-%token <Ast_c.info> TDot TComma TPtrOp
+
+%token <Ast_c.info> TOPar TCPar TOBrace TCBrace TOCro TCCro
+%token <Ast_c.info> TDot TComma TPtrOp
%token <Ast_c.info> TInc TDec
-%token <Ast_c.assignOp * Ast_c.info> TAssign
+%token <Ast_c.assignOp * Ast_c.info> TAssign
%token <Ast_c.info> TEq
%token <Ast_c.info> TWhy TTilde TBang
%token <Ast_c.info> TEllipsis
%token <Ast_c.info> TDotDot
%token <Ast_c.info> TPtVirg
-%token <Ast_c.info>
+%token <Ast_c.info>
TOrLog TAndLog TOr TXor TAnd TEqEq TNotEq TInf TSup TInfEq TSupEq
- TShl TShr
- TPlus TMinus TMul TDiv TMod
+ TShl TShr
+ TPlus TMinus TMul TDiv TMod
%token <Ast_c.info>
Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid
- Tauto Tregister Textern Tstatic
- Ttypedef
+ Tsize_t Tssize_t Tptrdiff_t
+ Tauto Tregister Textern Tstatic
+ Ttypedef
Tconst Tvolatile
- Tstruct Tunion Tenum
+ Tstruct Tunion Tenum
Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif Twhile Treturn
Tgoto Tdefault
- Tsizeof
+ Tsizeof Tnew Tdelete TOParCplusplusInit
/*(* C99 *)*/
%token <Ast_c.info>
/*(*-----------------------------------------*)*/
%token <Ast_c.info> Tasm
%token <Ast_c.info> Tattribute
+%token <Ast_c.info> TattributeNoarg
%token <Ast_c.info> Tinline
%token <Ast_c.info> Ttypeof
%token <(string * Ast_c.info)> TDefParamVariadic
/*(* disappear after fix_tokens_define *)*/
-%token <Ast_c.info> TCppEscapedNewline
+%token <Ast_c.info> TCppEscapedNewline
+
+%token <Ast_c.info> TCppConcatOp
/*(* appear after fix_tokens_define *)*/
-%token <Ast_c.info> TOParDefine
+%token <Ast_c.info> TOParDefine
%token <Ast_c.info> TOBraceDefineInit
%token <(string * Ast_c.info)> TIdentDefine /*(* same *)*/
/*(*---------------*)*/
/*(* coupling: Token_helpers.is_cpp_instruction *)*/
-%token <((int * int) option ref * Ast_c.info)>
+%token <((int * int) option ref * Ast_c.info)>
TIfdef TIfdefelse TIfdefelif TEndif
-%token <(bool * (int * int) option ref * Ast_c.info)>
+%token <(bool * (int * int) option ref * Ast_c.info)>
TIfdefBool TIfdefMisc TIfdefVersion
/*(*---------------*)*/
/*(* other *)*/
/*(*---------------*)*/
-
-%token <string * Ast_c.info> TUndef
+%token <Ast_c.info> TUndef
%token <Ast_c.info> TCppDirectiveOther
%token <(string * Ast_c.info)> TMacroAttr
%token <(string * Ast_c.info)> TMacroStmt
+%token <(string * Ast_c.info)> TMacroIdentBuilder
/*(* no need value for the moment *)*/
-%token <(string * Ast_c.info)> TMacroString
+%token <(string * Ast_c.info)> TMacroString
%token <(string * Ast_c.info)> TMacroDecl
-%token <Ast_c.info> TMacroDeclConst
-%token <(string * Ast_c.info)> TMacroStructDecl
+%token <Ast_c.info> TMacroDeclConst
+
%token <(string * Ast_c.info)> TMacroIterator
-/*(* %token <(string * Ast_c.info)> TMacroTop *)*/
+/*(*
+%token <(string * Ast_c.info)> TMacroTop
+%token <(string * Ast_c.info)> TMacroStructDecl
+*)*/
%token <(string * Ast_c.info)> TMacroAttrStorage
/*(* other *)*/
/*(*---------------*)*/
+
+/*(* should disappear after parsing_hack *)*/
+%token <Ast_c.info> TCommentSkipTagStart TCommentSkipTagEnd
+
+
/*(* appear after parsing_hack *)*/
-%token <Ast_c.info> TCParEOL
+%token <Ast_c.info> TCParEOL
%token <Ast_c.info> TAction
+/*(* TCommentMisc still useful ? obsolete ? *)*/
%token <Ast_c.info> TCommentMisc
-%token <(Ast_c.cppcommentkind * Ast_c.info)> TCommentCpp
+%token <(Token_c.cppcommentkind * Ast_c.info)> TCommentCpp
/*(*-----------------------------------------*)*/
%left TAndLog
%left TOr
%left TXor
-%left TAnd
+%left TAnd
%left TEqEq TNotEq
-%left TInf TSup TInfEq TSupEq
+%left TInf TSup TInfEq TSupEq
%left TShl TShr
%left TPlus TMinus
-%left TMul TDiv TMod
+%left TMul TDiv TMod
/*(*************************************************************************)*/
/*(* Rules type declaration *)*/
/*
(* TOC:
* toplevel (obsolete)
- *
+ *
* ident
* expression
* statement
- * types with
- * - left part (type_spec, qualif),
+ * types with
+ * - left part (type_spec, qualif),
* - right part (declarator, abstract declarator)
* - aux part (parameters)
* declaration, storage, initializers
* enum
* cpp directives
* celem (=~ main)
- *
+ *
* generic workarounds (obrace, cbrace for context setting)
* xxx_list, xxx_opt
*)
/*(*************************************************************************)*/
/*(* no more used; now that use error recovery *)*/
-main: translation_unit EOF { $1 }
+main:
+ translation_unit EOF { $1 }
-translation_unit:
- | external_declaration
+translation_unit:
+ | external_declaration
{ !LP._lexer_hint.context_stack <- [LP.InTopLevel]; [$1] }
| translation_unit external_declaration
{ !LP._lexer_hint.context_stack <- [LP.InTopLevel]; $1 ++ [$2] }
/*(* ident *)*/
/*(*************************************************************************)*/
-/*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C,
+/*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C,
* so a label can have the same name that a typedef, same for field and tags
* hence sometimes the use of ident instead of TIdent.
*)*/
-ident:
+ident:
| TIdent { $1 }
| TypedefIdent { $1 }
identifier:
| TIdent { $1 }
+/*
+(* cppext: string concatenation of idents
+ * also cppext: gccext: ##args for variadic macro
+ *)
+*/
+identifier_cpp:
+ | TIdent
+ { RegularName (mk_string_wrap $1) }
+ | ident_extra_cpp { $1 }
+
+ident_cpp:
+ | TIdent
+ { RegularName (mk_string_wrap $1) }
+ | TypedefIdent
+ { RegularName (mk_string_wrap $1) }
+ | ident_extra_cpp { $1 }
+
+ident_extra_cpp:
+ | TIdent TCppConcatOp identifier_cpp_list
+ {
+ CppConcatenatedName (
+ match $3 with
+ | [] -> raise (Impossible 87)
+ | (x,concatnull)::xs ->
+ assert(null concatnull);
+ (mk_string_wrap $1, [])::(x,[$2])::xs
+ )
+ }
+ | TCppConcatOp TIdent
+ { CppVariadicName (fst $2, [$1; snd $2]) }
+ | TMacroIdentBuilder TOPar param_define_list TCPar
+ { CppIdentBuilder ((fst $1, [snd $1;$2;$4]), $3) }
+
+identifier_cpp_list:
+ | TIdent { [mk_string_wrap $1, []] }
+ | identifier_cpp_list TCppConcatOp TIdent { $1 ++ [mk_string_wrap $3, [$2]] }
+
/*(*************************************************************************)*/
/*(* expr *)*/
/*(*************************************************************************)*/
-expr:
+expr:
| assign_expr { $1 }
| expr TComma assign_expr { mk_e (Sequence ($1,$3)) [$2] }
-/*(* bugfix: in C grammar they put unary_expr, but in fact it must be
+/*(* bugfix: in C grammar they put unary_expr, but in fact it must be
* cast_expr, otherwise (int * ) xxx = &yy; is not allowed
*)*/
-assign_expr:
+assign_expr:
| cond_expr { $1 }
| cast_expr TAssign assign_expr { mk_e(Assignment ($1,fst $2,$3)) [snd $2]}
| cast_expr TEq assign_expr { mk_e(Assignment ($1,SimpleAssign,$3)) [$2]}
-/*(* gccext: allow optional then part hence gcc_opt_expr
+/*(* gccext: allow optional then part hence gcc_opt_expr
* bugfix: in C grammar they put TDotDot cond_expr, but in fact it must be
* assign_expr, otherwise pnp ? x : x = 0x388 is not allowed
*)*/
-cond_expr:
- | arith_expr
+cond_expr:
+ | arith_expr
{ $1 }
- | arith_expr TWhy gcc_opt_expr TDotDot assign_expr
- { mk_e (CondExpr ($1,$3,$5)) [$2;$4] }
+ | arith_expr TWhy gcc_opt_expr TDotDot assign_expr
+ { mk_e (CondExpr ($1,$3,$5)) [$2;$4] }
-arith_expr:
+arith_expr:
| cast_expr { $1 }
| arith_expr TMul arith_expr { mk_e(Binary ($1, Arith Mul, $3)) [$2] }
| arith_expr TDiv arith_expr { mk_e(Binary ($1, Arith Div, $3)) [$2] }
| arith_expr TAndLog arith_expr { mk_e(Binary ($1, Logical AndLog, $3)) [$2] }
| arith_expr TOrLog arith_expr { mk_e(Binary ($1, Logical OrLog, $3)) [$2] }
-cast_expr:
+cast_expr:
| unary_expr { $1 }
| topar2 type_name tcpar2 cast_expr { mk_e(Cast ($2, $4)) [$1;$3] }
-unary_expr:
+unary_expr:
| postfix_expr { $1 }
| TInc unary_expr { mk_e(Infix ($2, Inc)) [$1] }
| TDec unary_expr { mk_e(Infix ($2, Dec)) [$1] }
| unary_op cast_expr { mk_e(Unary ($2, fst $1)) [snd $1] }
| Tsizeof unary_expr { mk_e(SizeOfExpr ($2)) [$1] }
| Tsizeof topar2 type_name tcpar2 { mk_e(SizeOfType ($3)) [$1;$2;$4] }
+ | Tnew new_argument { mk_e(New $2) [$1] }
+ | Tdelete cast_expr { mk_e(Delete $2) [$1] }
+
+new_argument:
+ | TIdent TOPar argument_list_ne TCPar
+ { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
+ Left (mk_e(FunCall (fn, $3)) [$2;$4]) }
+ | TIdent TOPar TCPar
+ { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
+ Left(mk_e(FunCall (fn, [])) [$2;$3]) }
+ | TypedefIdent TOPar argument_list_ne TCPar
+ { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
+ Left (mk_e(FunCall (fn, $3)) [$2;$4]) }
+ | TypedefIdent TOPar TCPar
+ { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
+ Left (mk_e(FunCall (fn, [])) [$2;$3]) }
+ | type_spec
+ { let ty = addTypeD ($1,nullDecl) in
+ let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam ty in
+ Right (ArgType { p_namei = None; p_type = returnType;
+ p_register = hasreg, iihasreg;
+ } )
+ }
+ | new_argument TOCro expr TCCro
+ {
+ match $1 with
+ Left(e) -> Left(mk_e(ArrayAccess (e, $3)) [$2;$4])
+ | Right(ArgType(ty)) -> (* lots of hacks to make the right type *)
+ let fty = mk_ty (Array (Some $3, ty.Ast_c.p_type)) [$2;$4] in
+ let pty = { ty with p_type = fty } in
+ Right(ArgType pty)
+ | _ -> raise (Impossible 88)
+ }
-unary_op:
+unary_op:
| TAnd { GetRef, $1 }
| TMul { DeRef, $1 }
| TPlus { UnPlus, $1 }
*)*/
| TAndLog { GetRefLabel, $1 }
-
-
-postfix_expr:
+postfix_expr:
| primary_expr { $1 }
- | postfix_expr TOCro expr TCCro
+ | postfix_expr TOCro expr TCCro
{ mk_e(ArrayAccess ($1, $3)) [$2;$4] }
- | postfix_expr TOPar argument_list_ne TCPar
+ | postfix_expr TOPar argument_list_ne TCPar
{ mk_e(FunCall ($1, $3)) [$2;$4] }
| postfix_expr TOPar TCPar { mk_e(FunCall ($1, [])) [$2;$3] }
- | postfix_expr TDot ident { mk_e(RecordAccess ($1,fst $3)) [$2;snd $3] }
- | postfix_expr TPtrOp ident { mk_e(RecordPtAccess ($1,fst $3)) [$2;snd $3] }
+ | postfix_expr TDot ident_cpp { mk_e(RecordAccess ($1,$3)) [$2] }
+ | postfix_expr TPtrOp ident_cpp { mk_e(RecordPtAccess ($1,$3)) [$2] }
| postfix_expr TInc { mk_e(Postfix ($1, Inc)) [$2] }
| postfix_expr TDec { mk_e(Postfix ($1, Dec)) [$2] }
/*(* gccext: also called compound literals *)*/
- | topar2 type_name tcpar2 TOBrace TCBrace
- { mk_e(Constructor ($2, [])) [$1;$3;$4;$5] }
+ | topar2 type_name tcpar2 TOBrace TCBrace
+ { mk_e(Constructor ($2, (InitList [], [$4;$5]))) [$1;$3] }
| topar2 type_name tcpar2 TOBrace initialize_list gcc_comma_opt TCBrace
- { mk_e(Constructor ($2, List.rev $5)) ([$1;$3;$4;$7] ++ $6) }
+ { mk_e(Constructor ($2, (InitList (List.rev $5),[$4;$7]++$6))) [$1;$3] }
-primary_expr:
- | identifier { mk_e(Ident (fst $1)) [snd $1] }
- | TInt { mk_e(Constant (Int (fst $1))) [snd $1] }
+
+primary_expr:
+ | identifier_cpp { mk_e(Ident ($1)) [] }
+ | TInt
+ { let (str,(sign,base)) = fst $1 in
+ mk_e(Constant (Int (str,Si(sign,base)))) [snd $1] }
| TFloat { mk_e(Constant (Float (fst $1))) [snd $1] }
| TString { mk_e(Constant (String (fst $1))) [snd $1] }
| TChar { mk_e(Constant (Char (fst $1))) [snd $1] }
| TOPar expr TCPar { mk_e(ParenExpr ($2)) [$1;$3] } /*(* forunparser: *)*/
/*(* gccext: cppext: TODO better ast ? *)*/
- | TMacroString { mk_e(Constant (MultiString)) [snd $1] }
- | string_elem string_list { mk_e(Constant (MultiString)) ($1 ++ $2) }
+ | TMacroString { mk_e(Constant (MultiString [fst $1])) [snd $1] }
+ | string_elem string_list
+ { mk_e(Constant (MultiString ["TODO: MultiString"])) ($1 ++ $2) }
/*(* gccext: allow statement as expressions via ({ statement }) *)*/
- | TOPar compound TCPar { mk_e(StatementExpr ($2)) [$1;$3] }
+ | TOPar compound TCPar { mk_e(StatementExpr ($2)) [$1;$3] }
/*(* cppext: *)*/
/*(* to avoid conflicts have to introduce a _not_empty (ne) version *)*/
-argument_ne:
+argument_ne:
| assign_expr { Left $1 }
| parameter_decl { Right (ArgType $1) }
| action_higherordermacro_ne { Right (ArgAction $1) }
-argument:
+argument:
| assign_expr { Left $1 }
| parameter_decl { Right (ArgType $1) }
/*(* had conflicts before, but julia fixed them *)*/
| action_higherordermacro { Right (ArgAction $1) }
-action_higherordermacro_ne:
- | taction_list_ne
+action_higherordermacro_ne:
+ | taction_list_ne
{ if null $1
then ActMisc [Ast_c.fakeInfo()]
else ActMisc $1
}
-action_higherordermacro:
- | taction_list
+action_higherordermacro:
+ | taction_list
{ if null $1
then ActMisc [Ast_c.fakeInfo()]
else ActMisc $1
topar2: TOPar { et "topar2" (); $1 }
-tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) }
+tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) }
/*(* statement *)*/
/*(*************************************************************************)*/
-statement:
+statement: statement2 { mk_st (fst $1) (snd $1) }
+
+statement2:
| labeled { Labeled (fst $1), snd $1 }
| compound { Compound (fst $1), snd $1 }
| expr_statement { ExprStatement(fst $1), snd $1 }
-/*(* note that case 1: case 2: i++; would be correctly parsed, but with
- * a Case (1, (Case (2, i++))) :(
+/*(* note that case 1: case 2: i++; would be correctly parsed, but with
+ * a Case (1, (Case (2, i++))) :(
*)*/
-labeled:
- | ident TDotDot statement { Label (fst $1, $3), [snd $1; $2] }
- | Tcase const_expr TDotDot statement { Case ($2, $4), [$1; $3] }
- | Tcase const_expr TEllipsis const_expr TDotDot statement
+labeled:
+ | ident_cpp TDotDot sw_stat_or_decl { Label ($1, $3), [$2] }
+ | Tcase const_expr TDotDot sw_stat_or_decl { Case ($2, $4), [$1; $3] }
+ | Tcase const_expr TEllipsis const_expr TDotDot sw_stat_or_decl
{ CaseRange ($2, $4, $6), [$1;$3;$5] } /*(* gccext: allow range *)*/
- | Tdefault TDotDot statement { Default $3, [$1; $2] }
+ | Tdefault TDotDot sw_stat_or_decl { Default $3, [$1; $2] }
+
+sw_stat_or_decl:
+ | decl { mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii }
+ | statement { $1 }
+
-end_labeled:
+end_labeled:
/*(* gccext: allow toto: }
* was generating each 30 shift/Reduce conflicts,
* mais ca va, ca fait ce qu'il faut.
- * update: julia fixed the problem by introducing end_labeled
+ * update: julia fixed the problem by introducing end_labeled
* and modifying below stat_or_decl_list
*)*/
- | ident TDotDot
- { Label (fst $1, (ExprStatement None, [])), [snd $1; $2] }
- | Tcase const_expr TDotDot { Case ($2, (ExprStatement None, [])), [$1;$3] }
- | Tdefault TDotDot { Default (ExprStatement None, []), [$1; $2] }
+ | ident_cpp TDotDot
+ { Label ($1, (mk_st (ExprStatement None) Ast_c.noii)), [$2] }
+ | Tcase const_expr TDotDot
+ { Case ($2, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$3] }
+ | Tdefault TDotDot
+ { Default (mk_st (ExprStatement None) Ast_c.noii), [$1; $2] }
* Moreover it helps to not make such a difference between decl and
* statement for further coccinelle phases to factorize code.
*)*/
-compound2:
+compound2:
| { ([]) }
| stat_or_decl_list { $1 }
-stat_or_decl_list:
- | stat_or_decl { [$1] }
+stat_or_decl_list:
+ | stat_or_decl { [$1] }
/*(* gccext: to avoid conflicts, cf end_labeled above *)*/
- | end_labeled { [StmtElem (Labeled (fst $1), snd $1)] }
+ | end_labeled { [StmtElem (mk_st (Labeled (fst $1)) (snd $1))] }
/*(* old: conflicts | stat_or_decl_list stat_or_decl { $1 ++ [$2] } *)*/
| stat_or_decl stat_or_decl_list { $1 :: $2 }
-stat_or_decl:
- | decl { StmtElem (Decl ($1 Ast_c.LocalDecl), []) }
+stat_or_decl:
+ | decl { StmtElem (mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii) }
| statement { StmtElem $1 }
/*(* gccext: *)*/
- | function_definition { StmtElem (NestedFunc $1, []) }
+ | function_definition { StmtElem (mk_st (NestedFunc $1) Ast_c.noii) }
/* (* cppext: *)*/
- | cpp_directive
+ | cpp_directive
{ CppDirectiveStmt $1 }
- | cpp_ifdef_directive/*(* stat_or_decl_list ...*)*/
+ | cpp_ifdef_directive/*(* stat_or_decl_list ...*)*/
{ IfdefStmt $1 }
-
-
-
-expr_statement:
+expr_statement:
| TPtVirg { None, [$1] }
| expr TPtVirg { Some $1, [$2] }
-selection:
+selection:
| Tif TOPar expr TCPar statement %prec SHIFTHERE
- { If ($3, $5, (ExprStatement None, [])), [$1;$2;$4] }
- | Tif TOPar expr TCPar statement Telse statement
+ { If ($3, $5, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$2;$4] }
+ | Tif TOPar expr TCPar statement Telse statement
{ If ($3, $5, $7), [$1;$2;$4;$6] }
- | Tswitch TOPar expr TCPar statement
+ | Tswitch TOPar expr TCPar statement
{ Switch ($3,$5), [$1;$2;$4] }
-iteration:
- | Twhile TOPar expr TCPar statement
+iteration:
+ | Twhile TOPar expr TCPar statement
{ While ($3,$5), [$1;$2;$4] }
- | Tdo statement Twhile TOPar expr TCPar TPtVirg
+ | Tdo statement Twhile TOPar expr TCPar TPtVirg
{ DoWhile ($2,$5), [$1;$3;$4;$6;$7] }
| Tfor TOPar expr_statement expr_statement TCPar statement
- { For ($3,$4,(None, []),$6), [$1;$2;$5]}
+ { For (ForExp $3,$4,(None, []),$6), [$1;$2;$5]}
| Tfor TOPar expr_statement expr_statement expr TCPar statement
- { For ($3,$4,(Some $5, []),$7), [$1;$2;$6] }
+ { For (ForExp $3,$4,(Some $5, []),$7), [$1;$2;$6] }
/*(* c++ext: for(int i = 0; i < n; i++)*)*/
- | Tfor TOPar decl expr_statement expr_opt TCPar statement
- {
- (* pr2 "DECL in for"; *)
- MacroIteration ("toto", [], $7),[] (* TODOfake ast, TODO need decl2 ? *)
- }
+ | Tfor TOPar decl expr_statement TCPar statement
+ { For (ForDecl ($3 Ast_c.LocalDecl),$4,(None, []),$6), [$1;$2;$5]}
+ | Tfor TOPar decl expr_statement expr TCPar statement
+ { For (ForDecl ($3 Ast_c.LocalDecl),$4,(Some $5, []),$7), [$1;$2;$6] }
/*(* cppext: *)*/
| TMacroIterator TOPar argument_list_ne TCPar statement
{ MacroIteration (fst $1, $3, $5), [snd $1;$2;$4] }
{ MacroIteration (fst $1, [], $4), [snd $1;$2;$3] }
/*(* the ';' in the caller grammar rule will be appended to the infos *)*/
-jump:
- | Tgoto ident { Goto (fst $2), [$1;snd $2] }
+jump:
+ | Tgoto ident_cpp { Goto ($2), [$1] }
| Tcontinue { Continue, [$1] }
| Tbreak { Break, [$1] }
- | Treturn { Return, [$1] }
+ | Treturn { Return, [$1] }
| Treturn expr { ReturnExpr $2, [$1] }
| Tgoto TMul expr { GotoComputed $3, [$1;$2] }
| TMacroString { [snd $1] }
-asmbody:
+asmbody:
| string_list colon_asm_list { $1, $2 }
| string_list { $1, [] } /*(* in old kernel *)*/
colon_asm: TDotDot colon_option_list { Colon $2, [$1] }
-colon_option:
+colon_option:
| TString { ColonMisc, [snd $1] }
- | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] }
+ | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] }
/*(* cppext: certainly a macro *)*/
| TOCro identifier TCCro TString TOPar asm_expr TCPar
{ ColonExpr $6, [$1;snd $2;$3;snd $4; $5; $7 ] }
/*(*************************************************************************)*/
/*(* types *)*/
/*(*************************************************************************)*/
-
+
/*(*-----------------------------------------------------------------------*)*/
/*(* Type spec, left part of a type *)*/
/*(*-----------------------------------------------------------------------*)*/
-type_spec2:
+type_spec2:
| Tvoid { Right3 (BaseType Void), [$1] }
| Tchar { Right3 (BaseType (IntType CChar)), [$1]}
| Tint { Right3 (BaseType (IntType (Si (Signed,CInt)))), [$1]}
| Tfloat { Right3 (BaseType (FloatType CFloat)), [$1]}
| Tdouble { Right3 (BaseType (FloatType CDouble)), [$1] }
+ | Tsize_t { Right3 (BaseType SizeType), [$1] }
+ | Tssize_t { Right3 (BaseType SSizeType), [$1] }
+ | Tptrdiff_t { Right3 (BaseType PtrDiffType), [$1] }
| Tshort { Middle3 Short, [$1]}
| Tlong { Middle3 Long, [$1]}
| Tsigned { Left3 Signed, [$1]}
| enum_spec { Right3 (fst $1), snd $1 }
/*
- (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar
- * ambiguous, generates lots of conflicts => we must
+ (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar
+ * ambiguous, generates lots of conflicts => we must
* use some tricks: we make the lexer and parser cooperate, cf lexerParser.ml.
- *
- * parse_typedef_fix2: this is not enough, and you must use
+ *
+ * parse_typedef_fix2: this is not enough, and you must use
* parse_typedef_fix2 to fully manage typedef problems in grammar.
- *
+ *
* parse_typedef_fix3:
- *
+ *
* parse_typedef_fix4: try also to do now some consistency checking in
* Parse_c
- *)*/
- | TypedefIdent { Right3 (TypeName (fst $1,Ast_c.noTypedefDef())), [snd $1]}
+ *)*/
+ | TypedefIdent
+ { let name = RegularName (mk_string_wrap $1) in
+ Right3 (TypeName (name, Ast_c.noTypedefDef())),[] }
| Ttypeof TOPar assign_expr TCPar { Right3 (TypeOfExpr ($3)), [$1;$2;$4] }
| Ttypeof TOPar type_name TCPar { Right3 (TypeOfType ($3)), [$1;$2;$4] }
/*(* Qualifiers *)*/
/*(*-----------------------------------------------------------------------*)*/
-type_qualif:
+type_qualif:
| Tconst { {const=true ; volatile=false}, $1 }
| Tvolatile { {const=false ; volatile=true}, $1 }
/*(* C99 *)*/
/*(* cppext: *)*/
| TMacroAttr { Attribute (fst $1), [snd $1] }
-
attribute_storage:
| TMacroAttrStorage { $1 }
/*(*-----------------------------------------------------------------------*)*/
/*
-(* declarator return a couple:
- * (name, partial type (a function to be applied to return type))
+(* declarator return a couple:
+ * (name, partial type (a function to be applied to return type))
*
* when int* f(int) we must return Func(Pointer int,int) and not
- * Pointer (Func(int,int)
+ * Pointer (Func(int,int)
*)*/
-declarator:
+declarator:
| pointer direct_d { (fst $2, fun x -> x +> $1 +> (snd $2) ) }
| direct_d { $1 }
/*(* so must do int * const p; if the pointer is constant, not the pointee *)*/
-pointer:
- | TMul { fun x ->(nQ, (Pointer x, [$1]))}
- | TMul type_qualif_list { fun x ->($2.qualifD, (Pointer x, [$1]))}
- | TMul pointer { fun x ->(nQ, (Pointer ($2 x),[$1]))}
- | TMul type_qualif_list pointer { fun x ->($2.qualifD, (Pointer ($3 x),[$1]))}
-
-
-direct_d:
- | identifier
+pointer:
+ | tmul { fun x -> mk_ty (Pointer x) [$1] }
+ | tmul pointer { fun x -> mk_ty (Pointer ($2 x)) [$1] }
+ | tmul type_qualif_list
+ { fun x -> ($2.qualifD, mk_tybis (Pointer x) [$1])}
+ | tmul type_qualif_list pointer
+ { fun x -> ($2.qualifD, mk_tybis (Pointer ($3 x)) [$1]) }
+
+tmul:
+ TMul { $1 }
+ | TAnd
+ { if !Flag.c_plus_plus
+ then $1
+ else
+ let i = Ast_c.parse_info_of_info $1 in
+ raise (Semantic("& not allowed in C types, try -c++ option", i)) }
+
+
+direct_d:
+ | identifier_cpp
{ ($1, fun x -> x) }
- | TOPar declarator TCPar /*(* forunparser: old: $2 *)*/
- { (fst $2, fun x -> (nQ, (ParenType ((snd $2) x), [$1;$3]))) }
- | direct_d tocro tccro
- { (fst $1,fun x->(snd $1) (nQ,(Array (None,x), [$2;$3]))) }
+ | TOPar declarator TCPar /*(* forunparser: old: $2 *)*/
+ { (fst $2, fun x -> mk_ty (ParenType ((snd $2) x)) [$1;$3]) }
+ | direct_d tocro tccro
+ { (fst $1,fun x->(snd $1) (mk_ty (Array (None,x)) [$2;$3])) }
| direct_d tocro const_expr tccro
- { (fst $1,fun x->(snd $1) (nQ,(Array (Some $3,x), [$2;$4])))}
+ { (fst $1,fun x->(snd $1) (mk_ty (Array (Some $3,x)) [$2;$4])) }
| direct_d topar tcpar
{ (fst $1,
- fun x->(snd $1)
- (nQ,(FunctionType (x,(([],(false, [])))),[$2;$3])))
+ fun x->(snd $1)
+ (mk_ty (FunctionType (x,(([],(false, []))))) [$2;$3]))
}
| direct_d topar parameter_type_list tcpar
- { (fst $1,fun x->(snd $1) (nQ,(FunctionType (x, $3), [$2;$4]))) }
+ { (fst $1,fun x->(snd $1)
+ (mk_ty (FunctionType (x, $3)) [$2;$4]))
+ }
/*(*----------------------------*)*/
tccro: TCCro { dt "tccro" ();$1 }
/*(*-----------------------------------------------------------------------*)*/
-abstract_declarator:
+abstract_declarator:
| pointer { $1 }
| direct_abstract_declarator { $1 }
| pointer direct_abstract_declarator { fun x -> x +> $2 +> $1 }
-direct_abstract_declarator:
+direct_abstract_declarator:
| TOPar abstract_declarator TCPar /*(* forunparser: old: $2 *)*/
- { (fun x -> (nQ, (ParenType ($2 x), [$1;$3]))) }
-
- | TOCro TCCro
- { fun x -> (nQ, (Array (None, x), [$1;$2]))}
- | TOCro const_expr TCCro
- { fun x -> (nQ, (Array (Some $2, x), [$1;$3]))}
- | direct_abstract_declarator TOCro TCCro
- { fun x ->$1 (nQ, (Array (None, x), [$2;$3])) }
+ { fun x -> mk_ty (ParenType ($2 x)) [$1;$3] }
+
+ | TOCro TCCro
+ { fun x -> mk_ty (Array (None, x)) [$1;$2] }
+ | TOCro const_expr TCCro
+ { fun x -> mk_ty (Array (Some $2, x)) [$1;$3] }
+ | direct_abstract_declarator TOCro TCCro
+ { fun x -> $1 (mk_ty (Array (None, x)) [$2;$3]) }
| direct_abstract_declarator TOCro const_expr TCCro
- { fun x ->$1 (nQ, (Array (Some $3,x), [$2;$4])) }
- | TOPar TCPar
- { fun x -> (nQ, (FunctionType (x, ([], (false, []))), [$1;$2])) }
- | TOPar parameter_type_list TCPar
- { fun x -> (nQ, (FunctionType (x, $2), [$1;$3]))}
- | direct_abstract_declarator TOPar TCPar
- { fun x ->$1 (nQ, (FunctionType (x, (([], (false, [])))),[$2;$3])) }
- | direct_abstract_declarator TOPar parameter_type_list TCPar
- { fun x -> $1 (nQ, (FunctionType (x, $3), [$2;$4])) }
+ { fun x -> $1 (mk_ty (Array (Some $3,x)) [$2;$4]) }
+ | TOPar TCPar
+ { fun x -> mk_ty (FunctionType (x, ([], (false, [])))) [$1;$2] }
+ | topar parameter_type_list tcpar
+ { fun x -> mk_ty (FunctionType (x, $2)) [$1;$3] }
+/*(* subtle: here must also use topar, not TOPar, otherwise if have for
+ * instance (xxx ( * )(xxx)) cast, then the second xxx may still be a Tident
+ * but we want to reduce topar, to set the InParameter so that
+ * parsing_hack can get a chance to change the type of xxx into a typedef.
+ * That's an example where parsing_hack and the lookahead of ocamlyacc does
+ * not go very well together ... we got the info too late. We got
+ * a similar pb with xxx xxx; declaration, cf parsing_hack.ml and the
+ * "disable typedef cos special case ..." message.
+*)*/
+ | direct_abstract_declarator topar tcpar
+ { fun x -> $1 (mk_ty (FunctionType (x, (([], (false, []))))) [$2;$3]) }
+ | direct_abstract_declarator topar parameter_type_list tcpar
+ { fun x -> $1 (mk_ty (FunctionType (x, $3)) [$2;$4]) }
/*(*-----------------------------------------------------------------------*)*/
/*(* Parameters (use decl_spec not type_spec just for 'register') *)*/
/*(*-----------------------------------------------------------------------*)*/
-parameter_type_list:
+parameter_type_list:
| parameter_list { ($1, (false, []))}
| parameter_list TComma TEllipsis { ($1, (true, [$2;$3])) }
-parameter_decl2:
+parameter_decl2:
+ TKRParam {
+ let name = RegularName (mk_string_wrap $1) in
+ LP.add_ident (str_of_name name);
+ { p_namei = Some name;
+ p_type = mk_ty NoType [];
+ p_register = (false, []);
+ }
+ }
| decl_spec declaratorp
- { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1
- in
- (hasreg, Some (fst (fst $2)), ((snd $2) returnType)),
- (iihasreg ++ [snd (fst $2)])
+ { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1 in
+ let (name, ftyp) = $2 in
+ { p_namei = Some (name);
+ p_type = ftyp returnType;
+ p_register = (hasreg, iihasreg);
+ }
}
| decl_spec abstract_declaratorp
- { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1
- in (hasreg, None, ($2 returnType)), (iihasreg ++ [])
+ { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
+ { p_namei = None;
+ p_type = $2 returnType;
+ p_register = hasreg, iihasreg;
+ }
}
| decl_spec
- { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1
- in (hasreg, None, returnType), (iihasreg ++ [])
+ { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
+ { p_namei = None;
+ p_type = returnType;
+ p_register = hasreg, iihasreg;
+ }
}
/*(*----------------------------*)*/
parameter_decl: parameter_decl2 { et "param" (); $1 }
+ | attributes parameter_decl2 { et "param" (); $2 }
-declaratorp:
- | declarator { LP.add_ident (fst (fst $1)); $1 }
+declaratorp:
+ | declarator { LP.add_ident (str_of_name (fst $1)); $1 }
/*(* gccext: *)*/
- | attributes declarator { LP.add_ident (fst (fst $2)); $2 }
- | declarator attributes { LP.add_ident (fst (fst $1)); $1 }
+ | attributes declarator { LP.add_ident (str_of_name (fst $2)); $2 }
+ | declarator attributes { LP.add_ident (str_of_name (fst $1)); $1 }
abstract_declaratorp:
| abstract_declarator { $1 }
/*(* for struct and also typename *)*/
/*(* cant put decl_spec cos no storage is allowed for field struct *)*/
-spec_qualif_list2:
+spec_qualif_list2:
| type_spec { addTypeD ($1, nullDecl) }
| type_qualif { {nullDecl with qualifD = (fst $1,[snd $1])}}
| type_spec spec_qualif_list { addTypeD ($1,$2) }
/*(* for pointers in direct_declarator and abstract_declarator *)*/
-type_qualif_list:
+type_qualif_list:
| type_qualif_attr { {nullDecl with qualifD = (fst $1,[snd $1])} }
| type_qualif_list type_qualif_attr { addQualifD ($2,$1) }
-
+
/*(*-----------------------------------------------------------------------*)*/
/*(* xxx_type_id *)*/
/*(*-----------------------------------------------------------------------*)*/
-type_name:
- | spec_qualif_list
+type_name:
+ | spec_qualif_list
{ let (returnType, _) = fixDeclSpecForDecl $1 in returnType }
| spec_qualif_list abstract_declaratort
{ let (returnType, _) = fixDeclSpecForDecl $1 in $2 returnType }
-abstract_declaratort:
+abstract_declaratort:
| abstract_declarator { $1 }
/*(* gccext: *)*/
| attributes abstract_declarator { $2 }
/*(* declaration and initializers *)*/
/*(*************************************************************************)*/
-decl2:
+decl2:
| decl_spec TPtVirg
{ function local ->
- let (returnType,storage) = fixDeclSpecForDecl $1 in
+ let (returnType,storage) = fixDeclSpecForDecl $1 in
let iistart = Ast_c.fakeInfo () in
- DeclList ([{v_namei = None; v_type = returnType;
+ DeclList ([{v_namei = None; v_type = returnType;
v_storage = unwrap storage; v_local = local;
v_attr = Ast_c.noattr;
- },[]],
+ v_type_bis = ref None;
+ },[]],
($2::iistart::snd storage))
- }
- | decl_spec init_declarator_list TPtVirg
+ }
+ | decl_spec init_declarator_list TPtVirg
{ function local ->
let (returnType,storage) = fixDeclSpecForDecl $1 in
let iistart = Ast_c.fakeInfo () in
DeclList (
- ($2 +> List.map (fun (((((s,iis),f),attrs), ini), iivirg) ->
- let ini, iini =
- match ini with
- | None -> None, []
- | Some (ini, iini) -> Some ini, [iini]
- in
- if fst (unwrap storage) = StoTypedef
+ ($2 +> List.map (fun ((((name,f),attrs), ini), iivirg) ->
+ let s = str_of_name name in
+ if fst (unwrap storage) =*= StoTypedef
then LP.add_typedef s;
- {v_namei = Some ((s, ini), iis::iini);
+ {v_namei = Some (name, ini);
v_type = f returnType;
v_storage = unwrap storage;
v_local = local;
v_attr = attrs;
+ v_type_bis = ref None;
},
- iivirg
+ iivirg
)
), ($3::iistart::snd storage))
- }
+ }
/*(* cppext: *)*/
- | TMacroDecl TOPar argument_list TCPar TPtVirg
+ | TMacroDecl TOPar argument_list TCPar TPtVirg
{ function _ ->
- MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
- | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg
+ MacroDecl ((fst $1, $3, true), [snd $1;$2;$4;$5;fakeInfo()]) }
+ | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg
{ function _ ->
- MacroDecl ((fst $2, $4), [snd $2;$3;$5;$6;fakeInfo();$1]) }
- | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg
+ MacroDecl ((fst $2, $4, true), [snd $2;$3;$5;$6;fakeInfo();$1]) }
+ | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg
{ function _ ->
- MacroDecl ((fst $3, $5), [snd $3;$4;$6;$7;fakeInfo();$1;$2])}
+ MacroDecl ((fst $3, $5, true), [snd $3;$4;$6;$7;fakeInfo();$1;$2])}
+
+
+ | TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg
+ { function _ ->
+ MacroDeclInit ((fst $1, $3, $6), [snd $1;$2;$4;$5;$7;fakeInfo()]) }
+ | Tstatic TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg
+ { function _ ->
+ MacroDeclInit ((fst $2, $4, $7),[snd $2;$3;$5;$6;$8;fakeInfo();$1]) }
+ | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar
+ teq initialize TPtVirg
+ { function _ ->
+ MacroDeclInit
+ ((fst $3, $5, $8), [snd $3;$4;$6;$7;$9;fakeInfo();$1;$2])}
/*(*-----------------------------------------------------------------------*)*/
-decl_spec2:
+decl_spec2:
| storage_class_spec { {nullDecl with storageD = (fst $1, [snd $1]) } }
| type_spec { addTypeD ($1,nullDecl) }
| type_qualif { {nullDecl with qualifD = (fst $1, [snd $1]) } }
| Tinline decl_spec2 { addInlineD ((true, $1), $2) }
/*(* can simplify by putting all in _opt ? must have at least one otherwise
- * decl_list is ambiguous ? (no cos have ';' between decl)
+ * decl_list is ambiguous ? (no cos have ';' between decl)
*)*/
-storage_class_spec2:
+storage_class_spec2:
| Tstatic { Sto Static, $1 }
| Textern { Sto Extern, $1 }
| Tauto { Sto Auto, $1 }
storage_class_spec:
/*(* gccext: *)*/
| storage_class_spec2 { $1 }
- | storage_class_spec2 attributes_storage { $1 (* TODO *) }
+ | storage_class_spec2 attribute_storage_list { $1 (* TODO *) }
/*(*-----------------------------------------------------------------------*)*/
/*(* declarators (right part of type and variable) *)*/
/*(*-----------------------------------------------------------------------*)*/
-init_declarator2:
- | declaratori { ($1, None) }
- | declaratori teq initialize { ($1, Some ($3, $2)) }
-
+init_declarator2:
+ | declaratori { ($1, NoInit) }
+ | declaratori teq initialize { ($1, ValInit($2, $3)) }
+ /* C++ only */
+ | declaratori TOParCplusplusInit argument_list TCPar
+ { ($1, ConstrInit($3,[$2;$4])) }
/*(*----------------------------*)*/
/*(* gccext: *)*/
/*(*----------------------------*)*/
-declaratori:
- | declarator { LP.add_ident (fst (fst $1)); $1, Ast_c.noattr }
+declaratori:
+ | declarator { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
/*(* gccext: *)*/
- | declarator gcc_asm_decl { LP.add_ident (fst (fst $1)); $1, Ast_c.noattr }
+ | declarator gcc_asm_decl { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
/*(* gccext: *)*/
- | attributes declarator { LP.add_ident (fst (fst $2)); $2, $1 }
- | declarator attributes { LP.add_ident (fst (fst $1)); $1, Ast_c.noattr (* TODO *) }
+ | attributes declarator { LP.add_ident (str_of_name (fst $2)); $2, $1 }
+ | declarator attributes { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr (* TODO *) }
-gcc_asm_decl:
+gcc_asm_decl:
| Tasm TOPar asmbody TCPar { }
| Tasm Tvolatile TOPar asmbody TCPar { }
/*(*-----------------------------------------------------------------------*)*/
-initialize:
- | assign_expr
+initialize:
+ | assign_expr
{ InitExpr $1, [] }
| tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini
{ InitList (List.rev $2), [$1;$4]++$3 }
/*
-(* opti: This time we use the weird order of non-terminal which requires in
- * the "caller" to do a List.rev cos quite critical. With this wierd order it
+(* opti: This time we use the weird order of non-terminal which requires in
+ * the "caller" to do a List.rev cos quite critical. With this weird order it
* allows yacc to use a constant stack space instead of exploding if we would
* do a 'initialize2 Tcomma initialize_list'.
*)
*/
-initialize_list:
+initialize_list:
| initialize2 { [$1, []] }
| initialize_list TComma initialize2 { ($3, [$2])::$1 }
/*(* gccext: condexpr and no assign_expr cos can have ambiguity with comma *)*/
-initialize2:
- | cond_expr
- { InitExpr $1, [] }
+initialize2:
+ | cond_expr
+ { InitExpr $1, [] }
| tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini
{ InitList (List.rev $2), [$1;$4]++$3 }
| tobrace_ini tcbrace_ini
{ InitList [], [$1;$2] }
/*(* gccext: labeled elements, a.k.a designators *)*/
- | designator_list TEq initialize2
+ | designator_list TEq initialize2
{ InitDesignators ($1, $3), [$2] }
/*(* gccext: old format *)*/
| ident TDotDot initialize2
{ InitFieldOld (fst $1, $3), [snd $1; $2] } /*(* in old kernel *)*/
-/* conflict
+/* conflict
| TOCro const_expr TCCro initialize2
{ InitIndexOld ($2, $4), [$1;$3] }
*/
-/*(* they can be nested, can have a .x.[3].y *)*/
-designator:
- | TDot ident
- { DesignatorField (fst $2), [$1;snd $2] }
- | TOCro const_expr TCCro
+/*(* they can be nested, can have a .x[3].y *)*/
+designator:
+ | TDot ident
+ { DesignatorField (fst $2), [$1;snd $2] }
+ | TOCro const_expr TCCro
{ DesignatorIndex ($2), [$1;$3] }
- | TOCro const_expr TEllipsis const_expr TCCro
+ | TOCro const_expr TEllipsis const_expr TCCro
{ DesignatorRange ($2, $4), [$1;$3;$5] }
/*(* workarounds *)*/
/*(*----------------------------*)*/
-gcc_comma_opt_struct:
- | TComma { [$1] }
+gcc_comma_opt_struct:
+ | TComma { [$1] }
| /*(* empty *)*/ { [Ast_c.fakeInfo() +> Ast_c.rewrap_str ","] }
/*(* struct *)*/
/*(*************************************************************************)*/
-s_or_u_spec2:
+s_or_u_spec2:
| struct_or_union ident tobrace_struct struct_decl_list_gcc tcbrace_struct
{ StructUnion (fst $1, Some (fst $2), $4), [snd $1;snd $2;$3;$5] }
| struct_or_union tobrace_struct struct_decl_list_gcc tcbrace_struct
{ StructUnion (fst $1, None, $3), [snd $1;$2;$4] }
- | struct_or_union ident
+ | struct_or_union ident
{ StructUnionName (fst $1, fst $2), [snd $1;snd $2] }
-struct_or_union2:
+struct_or_union2:
| Tstruct { Struct, $1 }
| Tunion { Union, $1 }
/*(* gccext: *)*/
-struct_decl2:
- | field_declaration { DeclarationField $1, noii }
- | TPtVirg { EmptyField, [$1] }
- | TMacroStructDecl { MacroStructDeclTodo, [] }
+struct_decl2:
+ | field_declaration { DeclarationField $1 }
+ | TPtVirg { EmptyField $1 }
+
+ /*(* no conflict ? no need for a TMacroStruct ? apparently not as at struct
+ * the rule are slightly different.
+ *)*/
+ | identifier TOPar argument_list TCPar TPtVirg
+ { MacroDeclField ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
/*(* cppext: *)*/
- | cpp_directive
- { CppDirectiveStruct $1, noii }
- | cpp_ifdef_directive/*(* struct_decl_list ... *)*/
- { IfdefStruct $1, noii }
+ | cpp_directive
+ { CppDirectiveStruct $1 }
+ | cpp_ifdef_directive/*(* struct_decl_list ... *)*/
+ { IfdefStruct $1 }
field_declaration:
- | spec_qualif_list struct_declarator_list TPtVirg
- {
+ | spec_qualif_list struct_declarator_list TPtVirg
+ {
let (returnType,storage) = fixDeclSpecForDecl $1 in
- if fst (unwrap storage) <> NoSto
+ if fst (unwrap storage) <> NoSto
then internal_error "parsing dont allow this";
-
- FieldDeclList ($2 +> (List.map (fun (f, iivirg) ->
+
+ FieldDeclList ($2 +> (List.map (fun (f, iivirg) ->
f returnType, iivirg))
,[$3])
(* dont need to check if typedef or func initialised cos
- * grammar dont allow typedef nor initialiser in struct
+ * grammar dont allow typedef nor initialiser in struct
*)
}
- | spec_qualif_list TPtVirg
- {
+ | spec_qualif_list TPtVirg
+ {
(* gccext: allow empty elements if it is a structdef or enumdef *)
let (returnType,storage) = fixDeclSpecForDecl $1 in
- if fst (unwrap storage) <> NoSto
+ if fst (unwrap storage) <> NoSto
then internal_error "parsing dont allow this";
-
- FieldDeclList ([(Simple (None, returnType), []) , []], [$2])
+
+ FieldDeclList ([(Simple (None, returnType)) , []], [$2])
}
-struct_declarator:
- | declaratorsd
- { (fun x -> Simple (Some (fst (fst $1)), (snd $1) x), [snd (fst $1)]) }
- | dotdot const_expr2
- { (fun x -> BitField (None, x, $2), [$1]) }
- | declaratorsd dotdot const_expr2
- { (fun x -> BitField (Some (fst(fst $1)),
- ((snd $1) x),
- $3),
- [snd (fst $1);$2])
- }
+struct_declarator:
+ | declaratorsd
+ { (fun x -> Simple (Some (fst $1), (snd $1) x)) }
+ | dotdot const_expr2
+ { (fun x -> BitField (None, x, $1, $2)) }
+ | declaratorsd dotdot const_expr2
+ { (fun x -> BitField (Some (fst $1), ((snd $1) x), $2, $3)) }
/*(*----------------------------*)*/
/*(* workarounds *)*/
/*(*----------------------------*)*/
-declaratorsd:
+declaratorsd:
| declarator { (*also ? LP.add_ident (fst (fst $1)); *) $1 }
/*(* gccext: *)*/
| attributes declarator { $2 }
dotdot: TDotDot { et "dotdot" (); $1 }
const_expr2: const_expr { dt "const_expr2" (); $1 }
-struct_decl_list_gcc:
- | struct_decl_list { $1 }
+struct_decl_list_gcc:
+ | struct_decl_list { $1 }
| /*(* empty *)*/ { [] } /*(* gccext: allow empty struct *)*/
/*(*************************************************************************)*/
/*(* enum *)*/
/*(*************************************************************************)*/
-enum_spec:
- | Tenum tobrace_enum enumerator_list gcc_comma_opt tcbrace_enum
+enum_spec:
+ | Tenum tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum
{ Enum (None, $3), [$1;$2;$5] ++ $4 }
- | Tenum ident tobrace_enum enumerator_list gcc_comma_opt tcbrace_enum
+ | Tenum ident tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum
{ Enum (Some (fst $2), $4), [$1; snd $2; $3;$6] ++ $5 }
- | Tenum ident
+ | Tenum ident
{ EnumName (fst $2), [$1; snd $2] }
-enumerator:
- | idente { (fst $1, None), [snd $1] }
- | idente TEq const_expr { (fst $1, Some $3), [snd $1; $2] }
-
+enumerator:
+ | idente { $1, None }
+ | idente TEq const_expr { $1, Some ($2, $3) }
/*(*----------------------------*)*/
/*(* workarounds *)*/
/*(*----------------------------*)*/
-idente: ident { LP.add_ident (fst $1); $1 }
+idente: ident_cpp { LP.add_ident (str_of_name $1); $1 }
/*(*************************************************************************)*/
function_definition: function_def { fixFunc $1 }
-decl_list:
+decl_list:
| decl { [$1 Ast_c.LocalDecl] }
| decl_list decl { $1 ++ [$2 Ast_c.LocalDecl] }
-function_def:
+/* hack : to drop when a better solution is found */
+cpp_directive_list:
+ | cpp_directive { }
+ | cpp_directive_list cpp_directive { }
+
+function_def:
| start_fun compound { LP.del_scope(); ($1, $2, None) }
- | start_fun decl_list compound {
+ | start_fun cpp_directive_list compound { LP.del_scope(); ($1, $3, None) }
+ | start_fun decl_list compound {
(* TODO: undo the typedef added ? *)
- LP.del_scope();
+ LP.del_scope();
($1, $3, Some $2)
}
-start_fun: start_fun2
- { LP.new_scope();
- fix_add_params_ident $1;
+start_fun: start_fun2
+ { LP.new_scope();
+ fix_add_params_ident $1;
(* toreput? !LP._lexer_hint.toplevel <- false; *)
- $1
+ $1
}
-start_fun2: decl_spec declaratorfd
+start_fun2: decl_spec declaratorfd
{ let (returnType,storage) = fixDeclSpecForFuncDef $1 in
let (id, attrs) = $2 in
- (fst id, fixOldCDecl ((snd id) returnType) , storage, attrs)
+ (fst id, fixOldCDecl ((snd id) returnType) , storage, attrs)
}
+ | ctor_dtor { $1 }
+
+ctor_dtor:
+ | Tconstructorname topar tcpar {
+ let id = RegularName (mk_string_wrap $1) in
+ let ret = mk_ty NoType [] in
+ let ty = mk_ty (FunctionType (ret, (([], (false, []))))) [$2;$3] in
+ let storage = ((NoSto,false),[]) in
+ let attrs = [] in
+ (id, ty, storage, attrs) }
+ | Tconstructorname topar parameter_type_list tcpar {
+ let id = RegularName (mk_string_wrap $1) in
+ let ret = mk_ty NoType [] in
+ let ty = mk_ty (FunctionType (ret, $3)) [$2;$4] in
+ let storage = ((NoSto,false),[]) in
+ let attrs = [] in
+ (id, ty, storage, attrs) }
/*(*----------------------------*)*/
/*(* workarounds *)*/
/*(*----------------------------*)*/
-declaratorfd:
+/* It would be very nice if we could make declarator aware that this is
+coming from a function definition. Then on the ( and ) cases, it could
+set the state to something other than InParameter. Then the case
+(TIdent (s, i1)::(TComma _|TCPar _)::_ , (TComma _ |TOPar _)::_ )
+in parsing_hacks.ml would not have to consider K&R variable declarations
+as typedefs. Unfortunately, doing something about this problem seems to
+introduce conflicts in the parser. */
+
+declaratorfd:
| declarator { et "declaratorfd" (); $1, Ast_c.noattr }
/*(* gccext: *)*/
| attributes declarator { et "declaratorfd" (); $2, $1 }
/*(* cpp directives *)*/
/*(*************************************************************************)*/
-cpp_directive:
- | TIncludeStart TIncludeFilename
- {
+cpp_directive:
+ | TIncludeStart TIncludeFilename
+ {
let (i1, in_ifdef) = $1 in
let (s, i2) = $2 in
(* redo some lexing work :( *)
- let inc_file =
+ let inc_file =
match () with
- | _ when s =~ "^\"\\(.*\\)\"$" ->
+ | _ when s =~ "^\"\\(.*\\)\"$" ->
Local (Common.split "/" (matched1 s))
- | _ when s =~ "^\\<\\(.*\\)\\>$" ->
+ | _ when s =~ "^\\<\\(.*\\)\\>$" ->
NonLocal (Common.split "/" (matched1 s))
- | _ ->
- Wierd s
+ | _ ->
+ Weird s
in
Include { i_include = (inc_file, [i1;i2]);
i_rel_pos = Ast_c.noRelPos();
}
}
- | TDefine TIdentDefine define_val TDefEOL
+ | TDefine TIdentDefine define_val TDefEOL
{ Define ((fst $2, [$1; snd $2;$4]), (DefineVar, $3)) }
/*
* A TOParDefine is a TOPar that was just next to the ident.
*)*/
| TDefine TIdentDefine TOParDefine param_define_list TCPar define_val TDefEOL
- { Define
- ((fst $2, [$1; snd $2;$7]),
- (DefineFunc ($4, [$3;$5]), $6))
+ { Define
+ ((fst $2, [$1; snd $2; $7]),
+ (DefineFunc ($4, [$3;$5]), $6))
}
- | TUndef { Undef (fst $1, [snd $1]) }
+ | TUndef TIdentDefine TDefEOL
+ { Define((fst $2, [$1; snd $2; $3]), (Undef,DefineEmpty)) }
| TCppDirectiveOther { PragmaAndCo ([$1]) }
-/*(* perhaps better to use assign_expr ? but in that case need
+
+
+
+
+/*(* perhaps better to use assign_expr ? but in that case need
* do a assign_expr_of_string in parse_c
*)*/
-define_val:
+define_val:
| expr { DefineExpr $1 }
| statement { DefineStmt $1 }
- | decl { DefineStmt (Decl ($1 Ast_c.NotLocalDecl), []) }
+ | decl { DefineStmt (mk_st (Decl ($1 Ast_c.NotLocalDecl)) Ast_c.noii) }
+
+/*(*old:
+ * | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))}
+ * get conflicts:
+ * | spec_qualif_list TMul
+ * { let (returnType, _) = fixDeclSpecForDecl $1 in DefineType returnType }
+ *)
+*/
+ | decl_spec
+ { let returnType = fixDeclSpecForMacro $1 in
+ DefineType returnType
+ }
+ | decl_spec abstract_declarator
+ { let returnType = fixDeclSpecForMacro $1 in
+ let typ = $2 returnType in
+ DefineType typ
+ }
+
+/*(* can be in conflict with decl_spec, maybe change fixDeclSpecForMacro
+ * to also allow storage ?
+ | storage_class_spec { DefineTodo }
+ | Tinline { DefineTodo }
+*)*/
+
+ | stat_or_decl stat_or_decl_list
+ { DefineMulti
+ (List.map
+ (function
+ StmtElem e -> e
+ | _ -> failwith "unexpected statement for DefineMulti")
+ ($1 :: $2)) }
+/*(*
+ | statement statement { DefineTodo }
+ | decl function_definition { DefineTodo }
+*)*/
+
+
+
-/*(*old: | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))}*)*/
- | spec_qualif_list { DefineTodo }
| function_definition { DefineFunction $1 }
- | TOBraceDefineInit initialize_list gcc_comma_opt_struct TCBrace comma_opt
+ | TOBraceDefineInit initialize_list gcc_comma_opt_struct TCBrace comma_opt
{ DefineInit (InitList (List.rev $2), [$1;$4]++$3++$5) }
/*(* note: had a conflict before when were putting TInt instead of expr *)*/
- | Tdo statement Twhile TOPar expr TCPar
+ | Tdo statement Twhile TOPar expr TCPar
{
- (* TOREPUT
- if fst $5 <> "0"
- then pr2 "WIERD: in macro and have not a while(0)";
+ (* TOREPUT
+ if fst $5 <> "0"
+ then pr2 "WEIRD: in macro and have not a while(0)";
*)
DefineDoWhileZero (($2,$5), [$1;$3;$4;$6])
}
- /*(* a few special cases *)*/
- | stat_or_decl stat_or_decl_list { DefineTodo }
-/*
- | statement statement { DefineTodo }
- | decl function_definition { DefineTodo }
-*/
-
| Tasm TOPar asmbody TCPar { DefineTodo }
| Tasm Tvolatile TOPar asmbody TCPar { DefineTodo }
-
/*(* aliases macro *)*/
| TMacroAttr { DefineTodo }
- | storage_class_spec { DefineTodo }
- | Tinline { DefineTodo }
| /*(* empty *)*/ { DefineEmpty }
+
+
param_define:
- | TIdent { fst $1, [snd $1] }
- | TypedefIdent { fst $1, [snd $1] }
- | TDefParamVariadic { fst $1, [snd $1] }
+ | TIdent { mk_string_wrap $1 }
+ | TypedefIdent { mk_string_wrap $1 }
+ | TDefParamVariadic { mk_string_wrap $1 }
| TEllipsis { "...", [$1] }
/*(* they reuse keywords :( *)*/
| Tregister { "register", [$1] }
-cpp_ifdef_directive:
- | TIfdef
- { let (tag,ii) = $1 in
+cpp_ifdef_directive:
+ | TIfdef
+ { let (tag,ii) = $1 in
IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
- | TIfdefelse
- { let (tag,ii) = $1 in
+ | TIfdefelse
+ { let (tag,ii) = $1 in
IfdefDirective ((IfdefElse, IfdefTag (Common.some !tag)), [ii]) }
- | TIfdefelif
- { let (tag,ii) = $1 in
+ | TIfdefelif
+ { let (tag,ii) = $1 in
IfdefDirective ((IfdefElseif, IfdefTag (Common.some !tag)), [ii]) }
- | TEndif
- { let (tag,ii) = $1 in
+ | TEndif
+ { let (tag,ii) = $1 in
IfdefDirective ((IfdefEndif, IfdefTag (Common.some !tag)), [ii]) }
- | TIfdefBool
- { let (_b, tag,ii) = $1 in
+ | TIfdefBool
+ { let (_b, tag,ii) = $1 in
IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
- | TIfdefMisc
- { let (_b, tag,ii) = $1 in
+ | TIfdefMisc
+ { let (_b, tag,ii) = $1 in
IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
- | TIfdefVersion
- { let (_b, tag,ii) = $1 in
+ | TIfdefVersion
+ { let (_b, tag,ii) = $1 in
IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
/*(* cppext: *)*/
-cpp_other:
+cpp_other:
/*(* no conflict ? no need for a TMacroTop ? apparently not as at toplevel
* the rule are slightly different, they cant be statement and so expr
* at the top, only decl or function definition.
*)*/
| identifier TOPar argument_list TCPar TPtVirg
- { MacroTop (fst $1, $3, [snd $1;$2;$4;$5]) }
+ {
+ Declaration(MacroDecl((fst $1, $3, true), [snd $1;$2;$4;$5;fakeInfo()]))
+ (* old: MacroTop (fst $1, $3, [snd $1;$2;$4;$5]) *)
+ }
/*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/
| identifier TOPar argument_list TCParEOL
- { MacroTop (fst $1, $3, [snd $1;$2;$4;fakeInfo()]) }
+ { Declaration (MacroDecl ((fst $1, $3, false), [snd $1;$2;$4;fakeInfo()])) }
/*(* ex: EXPORT_NO_SYMBOLS; *)*/
| identifier TPtVirg { EmptyDef [snd $1;$2] }
/*(* celem *)*/
/*(*************************************************************************)*/
-external_declaration:
+external_declaration:
| function_definition { Definition $1 }
| decl { Declaration ($1 Ast_c.NotLocalDecl) }
-celem:
- | external_declaration { $1 }
+celem:
+ | external_declaration { $1 }
/*(* cppext: *)*/
- | cpp_directive
+ | cpp_directive
{ CppTop $1 }
- | cpp_other
+ | cpp_other
{ $1 }
| cpp_ifdef_directive /* (*external_declaration_list ...*)*/
{ IfdefTop $1 }
/*(* can have asm declaration at toplevel *)*/
- | Tasm TOPar asmbody TCPar TPtVirg { EmptyDef [$1;$2;$4;$5] }
+ | Tasm TOPar asmbody TCPar TPtVirg { EmptyDef [$1;$2;$4;$5] }
/*
(* in ~/kernels/src/linux-2.5.2/drivers/isdn/hisax/isdnl3.c sometimes
- * the function ends with }; instead of just }
+ * the function ends with }; instead of just }
* can also remove this rule and report "parse error" pb to morton
*)*/
- | TPtVirg { EmptyDef [$1] }
+ | TPtVirg { EmptyDef [$1] }
-
- | EOF { FinalDef $1 }
+
+ | EOF { FinalDef $1 }
-topar: TOPar
- { LP.new_scope ();et "topar" ();
+topar: TOPar
+ { LP.new_scope ();et "topar" ();
LP.push_context LP.InParameter;
- $1
+ $1
}
-tcpar: TCPar
- { LP.del_scope ();dt "tcpar" ();
- LP.pop_context ();
- $1
+tcpar: TCPar
+ { LP.del_scope ();dt "tcpar" ();
+ LP.pop_context ();
+ $1
}
/*(* old:
-compound2:
+compound2:
| { ([],[]) }
| statement_list { ([], $1) }
| decl_list { ($1, []) }
/*(*
-decl_list:
+decl_list:
| decl { [$1] }
| decl_list decl { $1 ++ [$2] }
-statement_list:
+statement_list:
| statement { [$1] }
| statement_list statement { $1 ++ [$2] }
*)*/
-string_list:
+string_list:
| string_elem { $1 }
- | string_list string_elem { $1 ++ $2 }
+ | string_list string_elem { $1 ++ $2 }
-colon_asm_list:
+colon_asm_list:
| colon_asm { [$1] }
| colon_asm_list colon_asm { $1 ++ [$2] }
-colon_option_list:
- | colon_option { [$1, []] }
+colon_option_list:
+ | colon_option { [$1, []] }
| colon_option_list TComma colon_option { $1 ++ [$3, [$2]] }
-argument_list_ne:
+argument_list_ne:
| argument_ne { [$1, []] }
| argument_list_ne TComma argument { $1 ++ [$3, [$2]] }
-argument_list:
+argument_list:
| argument { [$1, []] }
| argument_list TComma argument { $1 ++ [$3, [$2]] }
*)*/
-struct_decl_list:
+struct_decl_list:
| struct_decl { [$1] }
| struct_decl_list struct_decl { $1 ++ [$2] }
-struct_declarator_list:
+struct_declarator_list:
| struct_declarator { [$1, []] }
| struct_declarator_list TComma struct_declarator { $1 ++ [$3, [$2]] }
-enumerator_list:
+enumerator_list:
| enumerator { [$1, []] }
| enumerator_list TComma enumerator { $1 ++ [$3, [$2]] }
-init_declarator_list:
+init_declarator_list:
| init_declarator { [$1, []] }
| init_declarator_list TComma init_declarator { $1 ++ [$3, [$2]] }
-parameter_list:
+parameter_list:
| parameter_decl { [$1, []] }
| parameter_list TComma parameter_decl { $1 ++ [$3, [$2]] }
-taction_list_ne:
+taction_list_ne:
| TAction { [$1] }
| TAction taction_list_ne { $1 :: $2 }
-taction_list:
-/*old: was generating conflict, hence now taction_list_ne
+taction_list:
+/*old: was generating conflict, hence now taction_list_ne
| (* empty *) { [] }
| TAction { [$1] }
| taction_list TAction { $1 ++ [$2] }
| { [] }
| TAction taction_list { $1 :: $2 }
-param_define_list:
+param_define_list:
| /*(* empty *)*/ { [] }
| param_define { [$1, []] }
| param_define_list TComma param_define { $1 ++ [$3, [$2]] }
-designator_list:
+designator_list:
| designator { [$1] }
| designator_list designator { $1 ++ [$2] }
attributes: attribute_list { $1 }
-attributes_storage: attribute_storage_list { $1 }
/*(* gccext: which allow a trailing ',' in enum, as in perl *)*/
-gcc_comma_opt:
- | TComma { [$1] }
+gcc_comma_opt:
+ | TComma { [$1] }
| /*(* empty *)*/ { [] }
-comma_opt:
- | TComma { [$1] }
+comma_opt:
+ | TComma { [$1] }
| /*(* empty *)*/ { [] }
/*(*
| { }
*)*/
-gcc_opt_expr:
+gcc_opt_expr:
| expr { Some $1 }
| /*(* empty *)*/ { None }
*)*/
-expr_opt:
- | expr { Some $1 }
- | /*(* empty *)*/ { None }
-