Source file parse_java.ml

(* Yoann Padioleau
 *
 * Copyright (C) 2010 Facebook
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file license.txt.
 *
 * This library 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
module PI = Parse_info

module TH = Token_helpers_java


(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* Lots of copy paste with my other parsers (e.g. C++, PHP, sql) but
 * copy paste is sometimes ok.
 *)

(*****************************************************************************)
(* Types *)
(*****************************************************************************)

(* the token list contains also the comment-tokens *)
type program_and_tokens = Ast_java.program option * Parser_java.token list

(*****************************************************************************)
(* Error diagnostic *)
(*****************************************************************************)
let error_msg_tok tok =
  Parse_info.error_message_info (TH.info_of_tok tok)

(*****************************************************************************)
(* Lexing only *)
(*****************************************************************************)

let tokens2 file =
 let table     = Parse_info.full_charpos_to_pos_large file in

 Common.with_open_infile file (fun chan ->
  let lexbuf = Lexing.from_channel chan in

    let rec tokens_aux () =
      let tok = Lexer_java.token lexbuf in
      if !Flag.debug_lexer then Common.pr2_gen tok;

      (* fill in the line and col information *)
      let tok = tok |> TH.visitor_info_of_tok (fun ii ->
        { ii with PI.token=
          (* could assert pinfo.filename = file ? *)
           match ii.PI.token with
           | PI.OriginTok pi ->
               PI.OriginTok
                 (PI.complete_token_location_large file table pi)
           | _ -> raise Todo
        })

      in

      if TH.is_eof tok
      then [tok]
      else tok::(tokens_aux ())
    in
    tokens_aux ()
 )

let tokens a =
  Common.profile_code "Java parsing.tokens" (fun () -> tokens2 a)

(*****************************************************************************)
(* Helper for main entry point *)
(*****************************************************************************)

(* Hacked lex. This function use refs passed by parse.
 * 'tr' means 'token refs'.
 *)
let rec lexer_function tr = fun lexbuf ->
  match tr.PI.rest with
  | [] -> (pr2 "LEXER: ALREADY AT END"; tr.PI.current)
  | v::xs ->
      tr.PI.rest <- xs;
      tr.PI.current <- v;
      tr.PI.passed <- v::tr.PI.passed;

      if TH.is_comment v (* || other condition to pass tokens ? *)
      then lexer_function (*~pass*) tr lexbuf
      else v

(*****************************************************************************)
(* Main entry point *)
(*****************************************************************************)
let parse2 filename =

  let stat = Parse_info.default_stat filename in
  let filelines = Common2.cat_array filename in

  let toks = tokens filename in
  let toks = Parsing_hacks_java.fix_tokens toks in

  let tr = Parse_info.mk_tokens_state toks in
  let checkpoint = TH.line_of_tok tr.PI.current in
  let lexbuf_fake = Lexing.from_function (fun _buf _n -> raise Impossible) in

  let elems =
    try (
      (* -------------------------------------------------- *)
      (* Call parser *)
      (* -------------------------------------------------- *)
      Left
        (Common.profile_code "Parser_java.main" (fun () ->
          Parser_java.goal (lexer_function tr) lexbuf_fake
        ))
    ) with Parsing.Parse_error ->

      let line_error = TH.line_of_tok tr.PI.current in

      let _passed_before_error = tr.PI.passed in
      let current = tr.PI.current in

      (* no error recovery, the whole file is discarded *)
      tr.PI.passed <- List.rev toks;

      let info_of_bads = Common2.map_eff_rev TH.info_of_tok tr.PI.passed in

      Right (info_of_bads, line_error, current)
  in

  match elems with
  | Left xs ->
      stat.PI.correct <- (Common.cat filename |> List.length);
      (Some xs, toks), stat

  | Right (_info_of_bads, line_error, cur) ->

      if not !Flag.error_recovery
      then raise (PI.Parsing_error (TH.info_of_tok cur));

      if !Flag.show_parsing_error
      then pr2 ("parse error \n = " ^ error_msg_tok cur);
      let checkpoint2 = Common.cat filename |> List.length in

      if !Flag.show_parsing_error
      then Parse_info.print_bad line_error (checkpoint, checkpoint2) filelines;
      stat.PI.bad     <- Common.cat filename |> List.length;
      (None, toks), stat

let parse a =
  Common.profile_code "Parse_java.parse" (fun () -> parse2 a)

let parse_program file =
  let ((ast, _toks), _stat) = parse file in
  Common2.some ast

let parse_string (w : string)
    : (Ast_java.program option * Parser_java.token list) * Parse_info.parsing_stat =
  Common2.with_tmp_file ~str:w ~ext:"java" parse

(*****************************************************************************)
(* Sub parsers *)
(*****************************************************************************)

(* for sgrep/spatch *)
let any_of_string s = 
  Common2.with_tmp_file ~str:s ~ext:"java" (fun file ->
    let toks = tokens file in
    let toks = Parsing_hacks_java.fix_tokens toks in

    let tr = PI.mk_tokens_state toks in
    let lexbuf_fake = Lexing.from_function (fun _buf _n -> raise Impossible) in
       (* -------------------------------------------------- *)
       (* Call parser *)
       (* -------------------------------------------------- *)
       Parser_java.sgrep_spatch_pattern (lexer_function tr) lexbuf_fake
  )