327 lines
10 KiB
OCaml
327 lines
10 KiB
OCaml
(* Yoann Padioleau
|
|
*
|
|
* Copyright (C) 2014 Facebook
|
|
* Copyright (C) 2002-2008 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
|
|
* file license.txt for more details.
|
|
*)
|
|
open Common
|
|
|
|
open Parser_cpp
|
|
open Token_views_cpp
|
|
|
|
module TH = Token_helpers_cpp
|
|
module TV = Token_views_cpp
|
|
|
|
(*****************************************************************************)
|
|
(* Prelude *)
|
|
(*****************************************************************************)
|
|
|
|
(*****************************************************************************)
|
|
(* Argument vs Parameter *)
|
|
(*****************************************************************************)
|
|
|
|
let look_like_argument _tok_before xs =
|
|
|
|
(* normalize for C++ *)
|
|
let xs = xs +> List.map (function
|
|
| Tok ({t=TAnd ii} as record) -> Tok ({record with t=TMul ii})
|
|
| x -> x
|
|
)
|
|
in
|
|
(* split by comma so can easily check if have stuff like '*xx'
|
|
* that takes the full argument
|
|
*)
|
|
let xxs = split_comma xs in
|
|
|
|
let aux1 xs =
|
|
match xs with
|
|
| [] -> false
|
|
(* *xx (note: actually can also be a function pointer decl) *)
|
|
| [Tok{t=TMul _}; Tok{t=TIdent _}] -> true
|
|
(* *(xx) *)
|
|
| [Tok{t=TMul _}; Parens _] -> true
|
|
(* TODO: xx * yy and space = 1 between the 2 :) *)
|
|
| _ -> false
|
|
in
|
|
|
|
let rec aux xs =
|
|
match xs with
|
|
| [] -> false
|
|
(* a function call probably *)
|
|
| Tok{t=TIdent _}::Parens _::_xs ->
|
|
(* todo? look_like_argument recursively in Parens || aux xs ? *)
|
|
true
|
|
(* if have = ... then must stop, could be default parameter of a method *)
|
|
| Tok{t=TEq _}::_xs -> false
|
|
|
|
(* could be part of a type declaration *)
|
|
| Tok {t=TOCro _}::Tok {t=TCCro _}::_xs -> false
|
|
| Tok {t=TOCro _}::Tok {t=(TInt _)}::Tok {t=TCCro _}::_xs -> false
|
|
| Tok {t=TOCro _}::Tok {t=(TIdent _)}::Tok {t=TCCro _}::_xs -> false
|
|
|
|
| x::xs ->
|
|
(match x with
|
|
| Tok {t=(TInt _ | TFloat _ | TChar _ | TString _) } -> true
|
|
| Tok {t=(Ttrue _ | Tfalse _) } -> true
|
|
| Tok {t=(Tthis _)} -> true
|
|
| Tok {t=(Tnew _ )} -> true
|
|
| Tok {t= tok} when TH.is_binary_operator_except_star tok -> true
|
|
| Tok {t=(TInc _ | TDec _)} -> true
|
|
| Tok {t = (TDot _ | TPtrOp _ | TPtrOpStar _ | TDotStar _)} -> true
|
|
| Tok {t = (TOCro _)} -> true
|
|
| Tok {t = (TWhy _ | TBang _)} -> true
|
|
| _ -> aux xs
|
|
)
|
|
in
|
|
(* todo? what if they contradict each other? if one say arg and
|
|
* the other a parameter?
|
|
*)
|
|
xxs +> List.exists aux1 || aux xs
|
|
|
|
let look_like_typedef s =
|
|
s =~ ".*_t$" ||
|
|
s = "ulong" || s = "uchar" || s = "uvlong" || s = "vlong" || s = "uintptr"
|
|
(* plan9, but actually some fp such as Paddr which is actually a macro *)
|
|
(* || s =~ "[A-Z][a-z].*$" *)
|
|
(* with DECLARE_BOOST_TYPE, but have some false positives
|
|
* when people do xx* indexPtr = const_cast<>(indexPtr);
|
|
*)
|
|
(* s =~ ".*Ptr$" *)
|
|
(* || s = "StringPiece" *)
|
|
|
|
|
|
|
|
(* todo: pass1, look for const, etc
|
|
* todo: pass2, look xx_t, xx&, xx*, xx**, see heuristics in typedef
|
|
*
|
|
* Many patterns should mimic some heuristics in parsing_hack_typedef.ml
|
|
*)
|
|
let look_like_parameter tok_before xs =
|
|
|
|
(* normalize for C++ *)
|
|
let xs = xs +> List.map (function
|
|
| Tok ({t=TAnd ii} as record) -> Tok ({record with t=TMul ii})
|
|
| x -> x
|
|
)
|
|
in
|
|
let xxs = split_comma xs in
|
|
|
|
let aux1 xs =
|
|
match xs with
|
|
| [] -> false
|
|
(* xx_t *)
|
|
| [Tok {t=TIdent (s, _)}] when look_like_typedef s -> true
|
|
(* xx* *)
|
|
| [Tok {t=TIdent _}; Tok {t=TMul _}] -> true
|
|
(* xx** *)
|
|
| [Tok {t=TIdent _}; Tok {t=TMul _}; Tok {t=TMul _}] -> true
|
|
(* xx * y could be multiplication (or xx & yy) ..
|
|
* todo: could look if space around :) but because of the
|
|
* filtering of template and qualifier the no_space_between
|
|
* may not be completely accurate here. May need lower level access
|
|
* to the list of TCommentSpace and their position.
|
|
* hmm but can look at col?
|
|
*
|
|
* C-s for parameter_decl in grammar to see that catch() is
|
|
* a InParameter.
|
|
*)
|
|
| [Tok {t=TIdent _}; Tok {t=TMul _};Tok {t=TIdent _};] ->
|
|
(match tok_before with
|
|
| Tok{t=(
|
|
Tcatch _
|
|
(* ugly: TIdent_Constructor interaction between past heuristics *)
|
|
| TIdent_Constructor _
|
|
| Toperator _
|
|
(* no! | TIdent _ *)
|
|
)} -> true
|
|
| _ -> false
|
|
)
|
|
|
|
| _ -> false
|
|
in
|
|
|
|
let rec aux xs =
|
|
match xs with
|
|
| [] -> false
|
|
(* xx yy *)
|
|
| Tok {t=TIdent _}::Tok{t=TIdent _}::_xs -> true
|
|
| x::xs ->
|
|
(match x with
|
|
| Tok {t= tok} when TH.is_basic_type tok -> true
|
|
| Tok {t = (Tconst _ | Tvolatile _)} -> true
|
|
| Tok {t = (Tstruct _ | Tunion _ | Tenum _ | Tclass _)} -> true
|
|
| _ -> aux xs
|
|
)
|
|
in
|
|
xxs +> List.exists aux1 || aux xs
|
|
|
|
|
|
(*****************************************************************************)
|
|
(* Main heuristics *)
|
|
(*****************************************************************************)
|
|
(*
|
|
* Most of the important contexts are introduced via some '{' '}'. To
|
|
* disambiguate is it often enough to just look at a few tokens before the
|
|
* '{'.
|
|
*
|
|
* Below we assume a view without:
|
|
* - comments
|
|
* - cpp directives
|
|
*
|
|
* todo
|
|
* - handle more C++ (right now I did it mostly to be able to parse plan9)
|
|
* - harder now that have c++, can have function inside struct so need
|
|
* handle all together.
|
|
* - change token but do not recurse in
|
|
* nested Braceised. maybe do via accumulator, don't use iter_token_brace?
|
|
* - need remove the qualifier as they make the sequence pattern matching
|
|
* more difficult?
|
|
*)
|
|
let set_context_tag_multi groups =
|
|
let rec aux xs =
|
|
match xs with
|
|
| [] -> ()
|
|
|
|
(* struct Foo {, also valid for class and union *)
|
|
| Tok{t=(Tstruct _ | Tunion _ | Tclass _)}::Tok{t=TIdent(s,_)}
|
|
::(Braces(_t1, _body, _t2) as braces)::xs
|
|
->
|
|
[braces] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InClassStruct s)::tok.TV.where;
|
|
);
|
|
aux (braces::xs)
|
|
|
|
| Tok{t=(Tstruct _ | Tunion _)}::(Braces(_t1, _body, _t2) as braces)::xs
|
|
->
|
|
[braces] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InClassStruct "__anon__")::tok.TV.where;
|
|
);
|
|
aux (braces::xs)
|
|
|
|
(* = { } *)
|
|
| Tok ({t=TEq _; _})::(Braces(_t1, _body, _t2) as braces)::xs ->
|
|
[braces] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- InInitializer::tok.TV.where;
|
|
);
|
|
aux (braces::xs)
|
|
|
|
(* enum xxx { InEnum *)
|
|
| Tok{t=Tenum _}::Tok{t=TIdent(_,_)}::(Braces(_t1, _body, _t2) as braces)::xs
|
|
| Tok{t=Tenum _}::(Braces(_t1, _body, _t2) as braces)::xs
|
|
->
|
|
[braces] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- TV.InEnum::tok.TV.where;
|
|
);
|
|
aux (braces::xs)
|
|
|
|
|
|
(* C++: class Foo : ... { *)
|
|
| Tok{t=Tclass _ | Tstruct _}::Tok{t=TIdent(s,_)}
|
|
::Tok{t= TCol ii}::xs
|
|
->
|
|
let (before, braces, after) =
|
|
try
|
|
xs +> Common2.split_when (function
|
|
| Braces _ -> true
|
|
| _ -> false
|
|
)
|
|
with Not_found ->
|
|
raise (UnclosedSymbol (spf "PB with split_when at %s"
|
|
(Parse_info.string_of_info ii)))
|
|
in
|
|
aux before;
|
|
[braces] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InClassStruct s)::tok.TV.where;
|
|
);
|
|
aux [braces];
|
|
aux after
|
|
|
|
|
|
|
|
(* need to look what was before to help the look_like_xxx heuristics
|
|
*
|
|
* The order of the 3 rules below is important. We must first try
|
|
* look_like_argument which has less FP than look_like_parameter
|
|
*)
|
|
| x::(Parens(_t1, body, _t2) as parens)::xs
|
|
when look_like_argument x body ->
|
|
(*msg_context t1.t (TV.InArgument); *)
|
|
[parens] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InArgument)::tok.TV.where;
|
|
);
|
|
(* todo? recurse on body? *)
|
|
aux [x];
|
|
aux (parens::xs)
|
|
|
|
(* C++: special cases *)
|
|
| (Tok{t=Toperator _} as tok1)::tok2::(Parens(_t1, body, _t2) as parens)::xs
|
|
when look_like_parameter tok1 body ->
|
|
(* msg_context t1.t (TV.InParameter); *)
|
|
[parens] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InParameter)::tok.TV.where;
|
|
);
|
|
(* recurse on body? hmm if InParameter should not have nested
|
|
* stuff except when pass function pointer
|
|
*)
|
|
aux [tok1;tok2];
|
|
aux (parens::xs)
|
|
|
|
|
|
| x::(Parens(_t1, body, _t2) as parens)::xs
|
|
when look_like_parameter x body ->
|
|
(* msg_context t1.t (TV.InParameter); *)
|
|
[parens] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InParameter)::tok.TV.where;
|
|
);
|
|
(* recurse on body? hmm if InParameter should not have nested
|
|
* stuff except when pass function pointer
|
|
*)
|
|
aux [x];
|
|
aux (parens::xs)
|
|
|
|
(* void xx() *)
|
|
| Tok{t=typ}::Tok{t=TIdent _}::(Parens(_t1, _body, _t2) as parens)::xs
|
|
when TH.is_basic_type typ ->
|
|
(* msg_context t1.t (TV.InParameter); *)
|
|
[parens] +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- (TV.InParameter)::tok.TV.where;
|
|
);
|
|
aux (parens::xs)
|
|
|
|
|
|
| x::xs ->
|
|
(match x with
|
|
| Tok _t -> ()
|
|
| Parens (_t1, xs, _t2)
|
|
| Braces (_t1, xs, _t2)
|
|
| Angle (_t1, xs, _t2)
|
|
->
|
|
aux xs
|
|
);
|
|
aux xs
|
|
in
|
|
(* sane initialization *)
|
|
groups +> TV.iter_token_multi (fun tok ->
|
|
tok.TV.where <- [TV.InTopLevel];
|
|
);
|
|
aux groups
|
|
|
|
(*****************************************************************************)
|
|
(* Main heuristics C++ *)
|
|
(*****************************************************************************)
|
|
(*
|
|
* assumes a view without:
|
|
* - template arguments, qualifiers,
|
|
* - comments and cpp directives
|
|
* - TODO public/protected/... ?
|
|
*)
|
|
let set_context_tag_cplus groups =
|
|
set_context_tag_multi groups
|