Add poc files

lang_cpp/parsing/token_views_cpp.ml

@@ -0,0 +1,665 @@
+(* Yoann Padioleau
+ * 
+ * Copyright (C) 2011, 2014 Facebook
+ * Copyright (C) 2007, 2008 Ecole des Mines de Nantes
+ *
+ * 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
+
+module Flag = Flag_parsing_cpp
+module PI = Parse_info
+module TH = Token_helpers_cpp
+
+open Parser_cpp
+
+(*****************************************************************************)
+(* Prelude  *)
+(*****************************************************************************)
+(* 
+ * This module makes it easier to write some fuzzy parsing heuristics
+ * by offering different "views" over the same set of tokens.
+ * 
+ * Normally I should not use ref/mutable in the token_extended type below
+ * and instead have a set of functions taking a list of tokens and
+ * returning a list of tokens. The problem is that to make easier some
+ * functions, it is better to work on better representation, on "views"
+ * over this list of tokens. But then modifying those views and get
+ * back from those views to the original simple list of tokens is
+ * tedious. One way is to maintain next to the view a list of "actions"
+ * (I was using a hash storing the charpos of the token and associating
+ * the action) but it is tedious too. Simpler to use mutable/ref. We
+ * use the same idea that we use when working on the Ast. 
+ *
+ * old: when I was using the list of "actions" next to the views, the hash
+ * indexed by the charpos, there could have been some problems:
+ * how my fake_pos interact with the way I tag and adjust token ?
+ * because I base my tagging on the position of the token ! so sometimes
+ * could tag another fakeInfo that should not be tagged ? 
+ * fortunately I don't use anymore this technique.
+ *)
+
+(*****************************************************************************)
+(* Some debugging functions  *)
+(*****************************************************************************)
+let pr2, _pr2_once = Common2.mk_pr2_wrappers Flag.verbose_parsing 
+
+(*****************************************************************************)
+(* Types *)
+(*****************************************************************************)
+
+type token_extended = { 
+  (* chose 't' and not 'tok' to have a short name because we will write
+   * lots of ocaml patterns around this ... so better to be short
+   *)
+  mutable t: Parser_cpp.token;
+  (* In C++ we have functions inside classes, so need a stack of context *)
+  mutable where: context list; 
+
+  (* less: need also a after ? *)
+  mutable new_tokens_before : Parser_cpp.token list;
+
+  (* line x col  cache (more easily accessible) of the info in the token *)
+  line: int; 
+  col : int;
+}
+ (* The strategy to tag is mostly to look at the token(s) before the '{' *)
+  and context = 
+    | InTopLevel
+    | InClassStruct of string (* can be __anon__ *) | InEnum
+    | InInitializer
+    | InAssign
+    | InParameter | InArgument
+   (* TODO actually commented in token_view_context because of c++ *)
+    | InFunction 
+(*
+    | InTemplateParam (* TODO *)
+*)
+
+(* InCondition ? InParenExpr ? *)
+
+(* x list list, because x list separated by ',' *) 
+type paren_grouped = 
+  | Parenthised   of paren_grouped list list * token_extended list
+  | PToken of token_extended
+
+type brace_grouped = 
+  | Braceised   of 
+      brace_grouped list list * token_extended * token_extended option
+  | BToken of token_extended
+
+(* Far better data structure than doing hacks in the lexer or parser
+ * because in lexer we don't know to which ifdef a endif is related
+ * and so when we want to comment a ifdef, we don't know which endif
+ * we must also comment. Especially true for the #if 0 which sometimes
+ * have a #else part.
+ * 
+ * x list list, because x list separated by #else or #elif 
+ *) 
+type ifdef_grouped = 
+  | Ifdef     of ifdef_grouped list list * token_extended list
+  | Ifdefbool of bool * ifdef_grouped list list * token_extended list
+  | NotIfdefLine of token_extended list
+
+
+type 'a line_grouped = 
+  Line of 'a list
+
+
+type body_function_grouped = 
+  | BodyFunction of token_extended list
+  | NotBodyLine  of token_extended list
+
+(* quite similar to ast_fuzzy.ml but with extended token *)
+type multi_grouped =
+  | Braces of token_extended * multi_grouped list * token_extended option
+  | Parens of token_extended * multi_grouped list * token_extended option
+  | Angle  of token_extended * multi_grouped list * token_extended option
+  | Tok of token_extended
+
+ (* with tarzan *)
+
+exception UnclosedSymbol of string
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+let mk_token_extended x = 
+  let info = TH.info_of_tok x in
+  let (line, col) = PI.line_of_info info, PI.col_of_info info in
+  { t = x; 
+    line = line; col = col; 
+    (* we use List.hd at a few places, so convenient to have a sentinel *)
+    where = [InTopLevel]; 
+    new_tokens_before = [];
+  }
+
+let mk_token_fake x = 
+  { t = x;
+    line = -1; col = -1;
+    where = [InTopLevel];
+    new_tokens_before = [];
+  }
+
+let rebuild_tokens_extented toks_ext = 
+  let _tokens = ref [] in
+  toks_ext +> List.iter (fun tok -> 
+    tok.new_tokens_before +> List.iter (fun x -> push x _tokens);
+    push tok.t _tokens 
+  );
+  let tokens = List.rev !_tokens in
+  (tokens +> Common2.acc_map mk_token_extended)
+
+(*****************************************************************************)
+(* View builders  *)
+(*****************************************************************************)
+
+(* ------------------------------------------------------------------------- *)
+(* Parens *)
+(* ------------------------------------------------------------------------- *)
+
+(* todo: synchro ! use more indentation 
+ * if paren not closed and same indentation level, certainly because
+ * part of a mid-ifdef-expression.
+ * 
+ * c++ext: TODO: need to handle templates here. 
+ * The parenthized view must not consider the ',' in expressions
+ * like foo(lexical cast<string,int>, ...) as a separator for the arguments
+ * of foo(), otherwise we will get [lexical_cast<string;  ...] which
+ * could confuse some heuristics.
+ * 
+ * pre: have done the TInf->TInf_Template translation.
+ *)
+let rec mk_parenthised xs = 
+  match xs with
+  | [] -> []
+  | x::xs -> 
+      (match x.t with 
+      | xx when TH.is_opar xx -> 
+          let body, extras, xs = mk_parameters [x] [] xs in
+          Parenthised (body,extras)::mk_parenthised xs
+      | _ -> 
+          PToken x::mk_parenthised xs
+      )
+
+(* return the body of the parenthised expression and the rest of the tokens *)
+and mk_parameters extras acc_before_sep  xs = 
+  match xs with
+  | [] -> 
+      (* maybe because of #ifdef which "opens" '(' in 2 branches *)
+      pr2 "PB: not found closing paren in fuzzy parsing";
+      [List.rev acc_before_sep], List.rev extras, []
+  | x::xs -> 
+      (match x.t with 
+      (* synchro *)
+      | xx when TH.is_obrace xx && x.col = 0 -> 
+          pr2 "PB: found synchro point } in paren";
+          [List.rev acc_before_sep], List.rev (extras), (x::xs)
+
+      | xx when TH.is_cpar xx  -> 
+          [List.rev acc_before_sep], List.rev (x::extras), xs
+      | xx when TH.is_opar xx -> 
+          let body, extrasnest, xs = mk_parameters [x] [] xs in
+          mk_parameters extras 
+            (Parenthised (body,extrasnest)::acc_before_sep) 
+            xs
+      | TComma _ -> 
+          let body, extras, xs = mk_parameters (x::extras) [] xs in
+          (List.rev acc_before_sep)::body, extras, xs 
+      | _ -> 
+          mk_parameters extras (PToken x::acc_before_sep) xs
+      )
+
+(* ------------------------------------------------------------------------- *)
+(* Brace *)
+(* ------------------------------------------------------------------------- *)
+
+let rec mk_braceised xs = 
+  match xs with
+  | [] -> []
+  | x::xs -> 
+      (match x.t with 
+      | xx when TH.is_obrace xx -> 
+          let body, endbrace, xs = mk_braceised_aux [] xs in
+          Braceised (body, x, endbrace)::mk_braceised xs
+      | xx when TH.is_cbrace xx -> 
+          pr2 "PB: found closing brace alone in fuzzy parsing";
+          BToken x::mk_braceised xs
+      | _ -> 
+          BToken x::mk_braceised xs
+      )
+
+(* return the body of the parenthised expression and the rest of the tokens *)
+and mk_braceised_aux acc xs = 
+  match xs with
+  | [] -> 
+      (* maybe because of #ifdef which "opens" '(' in 2 branches *)
+      pr2 "PB: not found closing brace in fuzzy parsing";
+      [List.rev acc], None, []
+  | x::xs -> 
+      (match x.t with 
+      | xx when TH.is_cbrace xx -> [List.rev acc], Some x, xs
+      | xx when TH.is_obrace xx -> 
+          let body, endbrace, xs = mk_braceised_aux [] xs in
+          mk_braceised_aux  (Braceised (body,x, endbrace)::acc) xs
+      | _ -> 
+          mk_braceised_aux (BToken x::acc) xs
+      )
+
+(* ------------------------------------------------------------------------- *)
+(* Ifdefs *)
+(* ------------------------------------------------------------------------- *)
+let rec mk_ifdef xs = 
+  match xs with
+  | [] -> []
+  | x::xs -> 
+      (match x.t with 
+      | TIfdef _ -> 
+          let body, extra, xs = mk_ifdef_parameters [x] [] xs in
+          Ifdef (body, extra)::mk_ifdef xs
+      | TIfdefBool (b,_) -> 
+          let body, extra, xs = mk_ifdef_parameters [x] [] xs in
+          
+          (* if not passing, then consider a #if 0 as an ordinary #ifdef *)
+          if !Flag.if0_passing
+          then Ifdefbool (b, body, extra)::mk_ifdef xs
+          else Ifdef(body, extra)::mk_ifdef xs
+
+      | TIfdefMisc (b,_) | TIfdefVersion (b,_) -> 
+          let body, extra, xs = mk_ifdef_parameters [x] [] xs in
+          Ifdefbool (b, body, extra)::mk_ifdef xs
+
+          
+      | _ -> 
+          (* todo? can have some Ifdef in the line ? *)
+          let line, xs = Common.span (fun y -> y.line = x.line) (x::xs) in
+          NotIfdefLine line::mk_ifdef xs 
+      )
+
+and mk_ifdef_parameters extras acc_before_sep xs = 
+  match xs with
+  | [] -> 
+      (* Note that mk_ifdef is assuming that CPP instruction are alone
+       * on their line. Because I do a span (fun x -> is_same_line ...)
+       * I might take with me a #endif if this one is mixed on a line
+       * with some "normal" tokens.
+       *)
+      pr2 "PB: not found closing ifdef in fuzzy parsing";
+      [List.rev acc_before_sep], List.rev extras, []
+  | x::xs -> 
+      (match x.t with 
+      | TEndif _ -> 
+          [List.rev acc_before_sep], List.rev (x::extras), xs
+      | TIfdef _ -> 
+          let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in
+          mk_ifdef_parameters 
+            extras (Ifdef (body, extrasnest)::acc_before_sep) xs
+
+      | TIfdefBool (b,_) -> 
+          let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in
+
+          if !Flag.if0_passing
+          then
+            mk_ifdef_parameters 
+              extras (Ifdefbool (b, body, extrasnest)::acc_before_sep) xs
+          else 
+            mk_ifdef_parameters 
+              extras (Ifdef (body, extrasnest)::acc_before_sep) xs
+
+
+      | TIfdefMisc (b,_) | TIfdefVersion (b,_) -> 
+          let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in
+          mk_ifdef_parameters 
+            extras (Ifdefbool (b, body, extrasnest)::acc_before_sep) xs
+
+      | TIfdefelse _ 
+      | TIfdefelif _ -> 
+          let body, extras, xs = mk_ifdef_parameters (x::extras) [] xs in
+          (List.rev acc_before_sep)::body, extras, xs 
+      | _ -> 
+          let line, xs = Common.span (fun y -> y.line = x.line) (x::xs) in
+          mk_ifdef_parameters extras (NotIfdefLine line::acc_before_sep) xs
+      )
+
+(* ------------------------------------------------------------------------- *)
+(* Lines (of parens) *)
+(* ------------------------------------------------------------------------- *)
+
+let line_of_paren = function
+  | PToken x -> x.line
+  | Parenthised (_xxs, info_parens) -> 
+      (match info_parens with
+      | [] -> raise Impossible
+      | x::_xs -> x.line
+      )
+
+
+(* old        
+let rec span_line_paren line = function
+  | [] -> [],[]
+  | x::xs -> 
+      (match x with
+      | PToken tok when TH.is_eof tok.t -> 
+          [], x::xs
+      | _ -> 
+        if line_of_paren x = line 
+        then
+          let (l1, l2) = span_line_paren line xs in
+          (x::l1, l2)
+        else ([], x::xs)
+      )
+
+let rec mk_line_parenthised xs = 
+  match xs with
+  | [] -> []
+  | x::xs -> 
+      let line_no = line_of_paren x in
+      let line, xs = span_line_paren line_no xs in
+      Line (x::line)::mk_line_parenthised xs
+*)
+
+let line_range_of_paren = function
+  | PToken x -> x.line, x.line
+  | Parenthised (_xxs, info_parens) -> 
+      (match info_parens with
+      | [] -> raise Impossible
+      | x::xs -> 
+          let lines_no = (x::xs) +> List.map (fun x -> x.line) in
+          Common2.minimum lines_no, Common2.maximum lines_no
+      )
+
+let rec span_line_paren_range (imin, imax) = function
+  | [] -> [],[]
+  | x::xs -> 
+      (match x with
+      | PToken tok when TH.is_eof tok.t -> 
+          [], x::xs
+      | _ -> 
+        if line_of_paren x >= imin && line_of_paren x <= imax
+        then
+          (* may need to extend *)
+          let (_imin', imax') = line_range_of_paren x in
+          let (l1, l2) = span_line_paren_range (imin, max imax imax') xs in
+          (x::l1, l2)
+        else ([], x::xs)
+      )
+
+
+let rec mk_line_parenthised xs = 
+  match xs with
+  | [] -> []
+  | x::xs -> 
+      let line_range = line_range_of_paren x in
+      let line, xs = span_line_paren_range line_range xs in
+      Line (x::line)::mk_line_parenthised xs
+
+(* ------------------------------------------------------------------------- *)
+(* Function body *)
+(* ------------------------------------------------------------------------- *)
+let rec mk_body_function_grouped xs = 
+  match xs with 
+  | [] -> []
+  | x::xs -> 
+      (match x with
+      | {t=TOBrace _; col = 0; _} -> 
+          let is_closing_brace = function 
+            | {t = TCBrace _; col = 0; _ } -> true 
+            | _ -> false 
+          in
+          let body, xs = Common.span (fun x -> not (is_closing_brace x)) xs in
+          (match xs with
+          | ({t = TCBrace _; col = 0; _ })::xs -> 
+              BodyFunction body::mk_body_function_grouped xs
+          | [] -> 
+              pr2 "PB:not found closing brace in fuzzy parsing";
+              [NotBodyLine body]
+          | _ -> raise Impossible
+          )
+          
+      | _ -> 
+          let line, xs = Common.span (fun y -> y.line = x.line) (x::xs) in
+          NotBodyLine line::mk_body_function_grouped xs 
+      )
+
+(* ------------------------------------------------------------------------- *)
+(* Multi ('{', '(', '<')  (could also do '[' ?) *)
+(* ------------------------------------------------------------------------- *)
+
+(* Assumes work on a list of tokens without comments, without ifdefs
+ * (todo? and without #define?).
+ * Used for typedef inference. Now also used for fuzzy parsing!
+ *
+ * todo? more fault tolerance, if col == 0 and { the reset!
+ * less: could check that it's consistent with the indentation
+ * 
+ *)
+let mk_multi xs =
+
+  let rec consume x xs =
+    match x with
+    | {t=(*TOBrace ii*)tok;_} when TH.is_obrace tok -> 
+        let body, closing, rest = look_close_brace x [] xs in
+        Braces (x, body, closing), rest
+    | {t=(*TOPar ii*)tok;_} when TH.is_opar tok ->
+        let body, closing, rest = look_close_paren x [] xs in
+        Parens (x, body, closing), rest
+    | {t=TInf_Template _ii;_} ->
+        let body, closing, rest = look_close_template x [] xs in
+        Angle (x, body, closing), rest
+    | x -> Tok x, xs
+  
+  and aux xs =
+  match xs with
+  | [] -> []
+  | x::xs ->
+      let x', xs' = consume x xs in
+      x'::aux xs'
+
+  and look_close_brace tok_start accbody xs =
+    match xs with
+    | [] -> 
+        raise (UnclosedSymbol (spf "PB look_close_brace (started at %d)" 
+                     (TH.line_of_tok tok_start.t)))
+    | x::xs -> 
+        (match x with
+        | {t=TCBrace _ii;_} -> List.rev accbody, Some x, xs
+
+        (* Many macros have unclosed '{'. An alternative
+         * would be to work on a view where define has been filtered
+         *)
+        | {t=TCommentNewline_DefineEndOfMacro _ii;_} ->
+            List.rev accbody, None, x::xs
+
+        | _ -> let (x', xs') = consume x xs in
+               look_close_brace tok_start (x'::accbody) xs'
+        )
+
+  and look_close_paren tok_start accbody xs =
+    match xs with
+    | [] -> 
+        raise (UnclosedSymbol (spf "PB look_close_paren (started at %d)" 
+                     (TH.line_of_tok tok_start.t)))
+    | x::xs -> 
+        (match x with
+        | {t=(*TCPar ii*)tok;_} when TH.is_cpar tok -> 
+            List.rev accbody, Some x, xs
+        | _ -> 
+            let (x', xs') = consume x xs in
+            look_close_paren tok_start (x'::accbody) xs'
+        )
+
+  and look_close_template tok_start accbody xs =
+    match xs with
+    | [] -> 
+        raise (UnclosedSymbol (spf "PB look_close_template (started at %d)" 
+                     (TH.line_of_tok tok_start.t)))
+    | x::xs -> 
+        (match x with
+        | {t=TSup_Template _ii;_} -> List.rev accbody, Some x, xs
+        | _ -> let (x', xs') = consume x xs in
+               look_close_template tok_start (x'::accbody) xs'
+        )
+  in
+  aux xs
+
+let split_comma xs =
+  xs +> Common2.split_gen_when (function
+  | Tok{t=TComma _;_}::xs -> Some xs
+  | _ -> None
+  )
+  
+(*****************************************************************************)
+(* View iterators  *)
+(*****************************************************************************)
+
+let rec iter_token_paren f xs = 
+  xs +> List.iter (function
+  | PToken tok -> f tok;
+  | Parenthised (xxs, info_parens) -> 
+      info_parens +> List.iter f;
+      xxs +> List.iter (fun xs -> iter_token_paren f xs)
+  )
+
+let rec iter_token_brace f xs = 
+  xs +> List.iter (function
+  | BToken tok -> f tok;
+  | Braceised (xxs, tok1, tok2opt) -> 
+      f tok1; do_option f tok2opt;
+      xxs +> List.iter (fun xs -> iter_token_brace f xs)
+  )
+
+let rec iter_token_ifdef f xs = 
+  xs +> List.iter (function
+  | NotIfdefLine xs -> xs +> List.iter f;
+  | Ifdefbool (_, xxs, info_ifdef) 
+  | Ifdef (xxs, info_ifdef) -> 
+      info_ifdef +> List.iter f;
+      xxs +> List.iter (iter_token_ifdef f)
+  )
+
+let rec iter_token_multi f xs =
+  xs +> List.iter (function
+  | Tok t -> f t
+  | Braces (t1, xs, t2)
+  | Parens (t1, xs, t2)
+  | Angle (t1, xs, t2)
+      ->  
+      f t1;
+      iter_token_multi f xs;
+      Common.do_option f t2
+  )
+
+let tokens_of_paren xs = 
+  let g = ref [] in
+  xs +> iter_token_paren (fun tok -> push tok g);
+  List.rev !g
+
+
+let tokens_of_paren_ordered xs = 
+  let g = ref [] in
+
+  let rec aux_tokens_ordered = function
+    | PToken tok -> push tok g;
+    | Parenthised (xxs, info_parens) -> 
+        let (opar, cpar, commas) = 
+          match info_parens with
+          | opar::xs -> 
+              (match List.rev xs with
+              | cpar::xs -> 
+                  opar, cpar, List.rev xs
+              | _ -> raise Impossible
+              )
+          | _ -> raise Impossible
+        in
+        push opar g;
+        aux_args (xxs,commas);
+        push cpar g;
+
+  and aux_args (xxs, commas) =
+    match xxs, commas with
+    | [], [] -> ()
+    | [xs], [] -> xs +> List.iter aux_tokens_ordered
+    | xs::ys::xxs, comma::commas -> 
+        xs +> List.iter aux_tokens_ordered;
+        push comma g;
+        aux_args (ys::xxs, commas)
+    | _ -> raise Impossible
+
+  in
+
+  xs +> List.iter aux_tokens_ordered;
+  List.rev !g
+
+let tokens_of_multi_grouped xs =
+  let res = ref [] in
+
+  let add x = Common.push x res in
+
+  let rec aux xs =
+    xs +> List.iter (function
+    | Tok t1 -> add t1
+    | Braces (t1, xs, t2)
+    | Parens (t1, xs, t2)
+    | Angle (t1, xs, t2) ->
+        add t1;
+        aux xs;
+        Common.do_option add t2
+    )
+  in
+  aux xs;
+  List.rev !res
+
+(*****************************************************************************)
+(* vof  *)
+(*****************************************************************************)
+
+let vof_context = function
+  | InTopLevel -> Ocaml.VSum ("T", [])
+  | InClassStruct _s -> Ocaml.VSum ("C", [])
+  | InEnum  -> Ocaml.VSum ("E", [])
+  | InInitializer -> Ocaml.VSum ("I", [])
+  | InAssign -> Ocaml.VSum ("=", [])
+  | InParameter -> Ocaml.VSum ("P", [])
+  | InArgument -> Ocaml.VSum ("A", [])
+  | InFunction -> Ocaml.VSum ("F", [])
+(*
+  | InTemplateParam -> Ocaml.VSum ("<>", [])
+*)
+
+let vof_token_extended t =
+  let info = TH.info_of_tok t.t in
+  let str = PI.str_of_info info in
+  let xs = List.map vof_context t.where in
+  Ocaml.VTuple [Ocaml.VString str; Ocaml.VList xs]
+
+let rec vof_multi_grouped =
+  function
+  | Braces ((v1, v2, v3)) ->
+      let v1 = vof_token_extended v1
+      and v2 = Ocaml.vof_list vof_multi_grouped v2
+      and v3 = Ocaml.vof_option vof_token_extended v3
+      in Ocaml.VSum (("Braces", [ v1; v2; v3 ]))
+  | Parens ((v1, v2, v3)) ->
+      let v1 = vof_token_extended v1
+      and v2 = Ocaml.vof_list vof_multi_grouped v2
+      and v3 = Ocaml.vof_option vof_token_extended v3
+      in Ocaml.VSum (("Parens", [ v1; v2; v3 ]))
+  | Angle ((v1, v2, v3)) ->
+      let v1 = vof_token_extended v1
+      and v2 = Ocaml.vof_list vof_multi_grouped v2
+      and v3 = Ocaml.vof_option vof_token_extended v3
+      in Ocaml.VSum (("Angle", [ v1; v2; v3 ]))
+  | Tok v1 -> let v1 = vof_token_extended v1 in Ocaml.VSum (("Tok", [ v1 ]))
+
+
+let vof_multi_grouped_list xs =
+  let v = Ocaml.VList (xs +> List.map vof_multi_grouped) in
+  v