hphp/hack/src/hh_single_compile.ml

   1 (**
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open Sys_utils
  12
  13 module P = Printf
  14 module SyntaxError = Full_fidelity_syntax_error
  15 module SourceText = Full_fidelity_source_text
  16 module SyntaxTree = Full_fidelity_syntax_tree
  17   .WithSyntax(Full_fidelity_positioned_syntax)
  18 module Lex = Full_fidelity_lexer
  19 module Logger = HackcEventLogger
  20
  21 (*****************************************************************************)
  22 (* Types, constants *)
  23 (*****************************************************************************)
  24 type mode =
  25   | CLI
  26   | DAEMON
  27
  28 type options = {
  29   filename          : string;
  30   fallback          : bool;
  31   config_list       : string list;
  32   debug_time        : bool;
  33   output_file       : string option;
  34   config_file       : string option;
  35   quiet_mode        : bool;
  36   mode              : mode;
  37   input_file_list   : string option;
  38   dump_symbol_refs  : bool;
  39   dump_stats        : bool;
  40   dump_config       : bool;
  41   extract_facts     : bool;
  42   log_stats         : bool;
  43   for_debugger_eval : bool;
  44 }
  45
  46 type message_handler = Hh_json.json -> string -> unit
  47
  48 type message_handlers = {
  49   set_config : message_handler;
  50   compile    : message_handler;
  51   facts      : message_handler;
  52   parse      : message_handler;
  53   error      : message_handler;
  54 }
  55
  56 (*****************************************************************************)
  57 (* Debug info refs *)
  58 (*****************************************************************************)
  59
  60 type debug_time = {
  61   parsing_t: float ref;
  62   codegen_t: float ref;
  63   printing_t: float ref;
  64 }
  65
  66 let new_debug_time () =
  67 {
  68   parsing_t = ref 0.0;
  69   codegen_t = ref 0.0;
  70   printing_t = ref 0.0;
  71 }
  72
  73 (*****************************************************************************)
  74 (* Helpers *)
  75 (*****************************************************************************)
  76
  77 let die str =
  78   prerr_endline str;
  79   exit 2
  80
  81 let is_file_path_for_evaled_code s =
  82   let s = Relative_path.to_absolute s in
  83   String_utils.string_ends_with s ") : eval()'d code"
  84
  85 let print_compiler_version () =
  86   let open Hh_json in
  87   let compiler_version_msg = json_to_string @@ JSON_Object
  88     [ ("type", JSON_String "compiler_version")
  89     ; ("version", JSON_String (Compiler_id.get_compiler_id ()))
  90     ] in
  91   P.printf "%s\n%!" compiler_version_msg
  92
  93 let assert_regular_file filename =
  94   if not (Sys.file_exists filename) ||
  95     (Unix.stat filename).Unix.st_kind <> Unix.S_REG
  96   then raise (Arg.Bad (filename ^ " not a valid file"))
  97
  98 let parse_options () =
  99   let fn_ref = ref None in
 100   let want_version = ref false in
 101   let fallback = ref false in
 102   let debug_time = ref false in
 103   let config_list = ref [] in
 104   let mode = ref CLI in
 105   let output_file = ref None in
 106   let config_file = ref None in
 107   let quiet_mode = ref false in
 108   let input_file_list = ref None in
 109   let dump_symbol_refs = ref false in
 110   let extract_facts = ref false in
 111   let dump_stats = ref false in
 112   let dump_config = ref false in
 113   let log_stats = ref false in
 114   let for_debugger_eval = ref false in
 115   let usage = P.sprintf "Usage: hh_single_compile (%s) filename\n" Sys.argv.(0) in
 116   let options =
 117     [ ("--version"
 118           , Arg.Set want_version
 119             , " print the version and do nothing"
 120       );
 121       ("--fallback"
 122           , Arg.Set fallback
 123             , " Enables fallback compilation"
 124       );
 125       ("--debug-time"
 126           , Arg.Set debug_time
 127             , " Enables debugging logging for elapsed time"
 128       );
 129       ("--quiet-mode"
 130           , Arg.Set quiet_mode
 131             , " Runs very quietly, and ignore any result if invoked without -o "
 132               ^ "(lower priority than the debug-time option)"
 133       );
 134       ("--facts"
 135           , Arg.Set extract_facts
 136           , "Extract facts from the source code."
 137       );
 138       ("-v"
 139           , Arg.String (fun str -> config_list := str :: !config_list)
 140             , " Configuration: Server.Port=<value> "
 141               ^ "\n"
 142               ^ "\t\tAllows overriding config options passed on a file"
 143       );
 144       ("-c"
 145       , Arg.String (fun str ->
 146         assert_regular_file str;
 147         config_file := Some str)
 148       , " Config file in JSON format"
 149       );
 150       ("-o"
 151           , Arg.String (fun str -> output_file := Some str)
 152             , " Output file. Creates it if necessary"
 153       );
 154       ("--daemon"
 155           , Arg.Unit (fun () -> mode := DAEMON)
 156             , " Run a daemon which processes Hack source from standard input"
 157       );
 158       ("--input-file-list"
 159           , Arg.String (fun str -> input_file_list := Some str)
 160             , " read a list of files (one per line) from the file `input-file-list'"
 161       );
 162       ("--dump-symbol-refs"
 163           , Arg.Set dump_symbol_refs
 164             , " Dump symbol ref sections of HHAS"
 165       );
 166       ("--dump-stats"
 167       , Arg.Set dump_stats
 168       , " Dump timing stats for functions"
 169       );
 170       ("--dump-config"
 171       , Arg.Set dump_config
 172       , " Dump configuration settings"
 173       );
 174       ("--enable-logging-stats"
 175       , Arg.Unit (fun () -> log_stats := true)
 176       , " Starts logging stats"
 177       );
 178       ("--stop-logging-stats"
 179       , Arg.Unit (fun () -> log_stats := false)
 180       , " Stop logging stats"
 181       );
 182       ("--for-debugger-eval"
 183       , Arg.Unit (fun () -> for_debugger_eval := true)
 184       , " Mutate the program as if we're in the debugger repl"
 185       );
 186     ] in
 187   let options = Arg.align ~limit:25 options in
 188   Arg.parse options (fun fn -> fn_ref := Some fn) usage;
 189   if !want_version then (print_compiler_version (); exit 0);
 190   if !mode = DAEMON then print_compiler_version ();
 191   let needs_file = Option.is_none !input_file_list in
 192   let fn =
 193     if needs_file then
 194       match !fn_ref with
 195         | Some fn -> if !mode = CLI then fn else die usage
 196         | None    -> if !mode = CLI then die usage else Caml.read_line ()
 197     else
 198       ""
 199   in
 200   { filename           = fn
 201   ; fallback           = !fallback
 202   ; config_list        = !config_list
 203   ; debug_time         = !debug_time
 204   ; output_file        = !output_file
 205   ; config_file        = !config_file
 206   ; quiet_mode         = !quiet_mode
 207   ; mode               = !mode
 208   ; input_file_list    = !input_file_list
 209   ; dump_symbol_refs   = !dump_symbol_refs
 210   ; dump_stats         = !dump_stats
 211   ; dump_config        = !dump_config
 212   ; log_stats          = !log_stats
 213   ; extract_facts      = !extract_facts
 214   ; for_debugger_eval  = !for_debugger_eval
 215   }
 216
 217 let fail_daemon file error =
 218   let open Hh_json in
 219   let file = Option.value ~default:"[unknown]" file in
 220   let msg = json_to_string @@ JSON_Object
 221     [ ("type", JSON_String "error")
 222     ; ("file", JSON_String file)
 223     ; ("error", JSON_String error)
 224     ] in
 225   P.printf "%s\n%!" msg;
 226   die error
 227
 228 let rec dispatch_loop handlers =
 229   let open Hh_json in
 230   let open Access in
 231   let read_message () =
 232     let line = Caml.read_line () in
 233     let header = json_of_string line in
 234     let file = get_field_opt (get_string "file") header in
 235     let bytes = get_field (get_number_int "bytes") (fun _af -> 0) header in
 236     let is_systemlib = get_field_opt (get_bool "is_systemlib") header in
 237     Emit_env.set_is_systemlib @@ Option.value ~default:false is_systemlib;
 238     let body = Bytes.create bytes in begin
 239     try
 240       Caml.really_input Caml.stdin body 0 bytes;
 241       header, body
 242     with exc ->
 243       fail_daemon file ("Exception reading message body: " ^ (Caml.Printexc.to_string exc))
 244     end in
 245   let header, body = read_message () in
 246   let msg_type = get_field
 247     (get_string "type")
 248     (fun af -> fail_daemon None ("Cannot determine type of message: " ^ af))
 249     header in
 250   (match msg_type with
 251     | "code"   -> handlers.compile header body
 252     | "error"  -> handlers.error header body
 253     | "config" -> handlers.set_config header body
 254     | "facts"  -> handlers.facts header body
 255     | "parse"  -> handlers.parse header body
 256     | _        -> fail_daemon None ("Unhandled message type '" ^ msg_type ^ "'"));
 257   dispatch_loop handlers
 258
 259 let set_stats_if_enabled ~compiler_options =
 260   if compiler_options.dump_stats then
 261     Stats_container.set_instance (Some (Stats_container.new_container ()))
 262
 263 let write_stats_if_enabled ~compiler_options =
 264   if compiler_options.dump_stats then
 265     match (Stats_container.get_instance ()) with
 266     | Some s -> Stats_container.write_out ~out:Caml.stderr s
 267     | None -> ()
 268
 269 let parse_text compiler_options popt fn text =
 270   let () = set_stats_if_enabled ~compiler_options in
 271   let ignore_pos =
 272     not (Hhbc_options.source_mapping !Hhbc_options.compiler_options) in
 273   let php5_compat_mode =
 274     not (Hhbc_options.enable_uniform_variable_syntax !Hhbc_options.compiler_options) in
 275   let hacksperimental =
 276     Hhbc_options.hacksperimental !Hhbc_options.compiler_options in
 277   let lower_coroutines =
 278     Hhbc_options.enable_coroutines !Hhbc_options.compiler_options in
 279   let pocket_universes =
 280     Hhbc_options.enable_pocket_universes !Hhbc_options.compiler_options in
 281   let popt = ParserOptions.setup_pocket_universes popt pocket_universes in
 282   let env = Full_fidelity_ast.make_env
 283     ~parser_options:popt
 284     ~ignore_pos
 285     ~codegen:true
 286     ~fail_open:false
 287     ~php5_compat_mode
 288     ~hacksperimental
 289     ~keep_errors:false
 290     ~lower_coroutines
 291     fn
 292   in
 293   let source_text = SourceText.make fn text in
 294   let { Full_fidelity_ast.ast; Full_fidelity_ast.is_hh_file; _ } =
 295     Full_fidelity_ast.from_text env source_text in
 296   let () = write_stats_if_enabled ~compiler_options in
 297   (ast, is_hh_file)
 298
 299 let parse_file compiler_options popt filename text =
 300   try
 301     `ParseResult (Errors.do_ begin fun () ->
 302       parse_text compiler_options popt filename text
 303     end)
 304   with
 305     (* FFP failed to parse *)
 306     | Failure s -> `ParseFailure ((SyntaxError.make 0 0 s), Pos.none)
 307     (* FFP generated an error *)
 308     | SyntaxError.ParserFatal (e, p) -> `ParseFailure (e, p)
 309
 310 let add_to_time_ref r t0 =
 311   let t = Unix.gettimeofday () in
 312   r := !r +. (t -. t0);
 313   t
 314
 315 let print_debug_time_info filename debug_time =
 316   let stat = Caml.Gc.stat () in
 317   (P.eprintf "File %s:\n" (Relative_path.to_absolute filename);
 318   P.eprintf "Parsing: %0.3f s\n" !(debug_time.parsing_t);
 319   P.eprintf "Codegen: %0.3f s\n" !(debug_time.codegen_t);
 320   P.eprintf "Printing: %0.3f s\n" !(debug_time.printing_t);
 321   P.eprintf "MinorWords: %0.3f\n" stat.Caml.Gc.minor_words;
 322   P.eprintf "PromotedWords: %0.3f\n" stat.Caml.Gc.promoted_words)
 323
 324 let mode_to_string = function
 325   | CLI -> "CLI"
 326   | DAEMON -> "DAEMON"
 327
 328 let log_success compiler_options filename debug_time =
 329   Logger.success
 330     ~filename:(Relative_path.to_absolute filename)
 331     ~parsing_t:!(debug_time.parsing_t)
 332     ~codegen_t:!(debug_time.codegen_t)
 333     ~printing_t:!(debug_time.printing_t)
 334     ~mode:(mode_to_string compiler_options.mode)
 335
 336 let log_fail compiler_options filename exc ~stack =
 337   Logger.fail
 338     ~filename:(Relative_path.to_absolute filename)
 339     ~mode:(mode_to_string compiler_options.mode)
 340     ~exc:(Caml.Printexc.to_string exc ^ "\n" ^ stack)
 341
 342 (* Maps an Ast to a Tast where every type is Tany
 343  * Used to produce a Tast for unsafe code without inferring types for it. *)
 344 module AstToTastEnv = struct
 345   module AastAnnotations = Tast.Annotations
 346   let get_expr_annotation (p: Ast_defs.pos) = p, (Typing_reason.Rnone, Typing_defs.Tany)
 347   let env_annotation = Tast.dummy_saved_env
 348   let funcbody_annotation = Tast.Annotations.FuncBodyAnnotation.HasUnsafeBlocks
 349 end
 350
 351 module AstToTast = Ast_to_aast.MapAstToAast(AstToTastEnv)
 352
 353 (**
 354  * Converts a legacy ast (ast.ml) into a typed ast (tast.ml / aast.ml)
 355  * so that codegen and typing both operate on the same ast structure.
 356  * There are some errors that are not valid hack but are still expected
 357  * to produce valid bytecode. These errors are caught during the conversion
 358  * so as to match legacy behavior.
 359  *)
 360 let convert_to_tast ast =
 361   let errors, tast =
 362     let convert () =
 363       let ast = AstToTast.convert ast in
 364       if Hhbc_options.enable_pocket_universes !Hhbc_options.compiler_options then
 365           Pocket_universes.translate ast
 366       else ast
 367     in
 368     Errors.do_ convert in
 369   let handle_error _path error acc =
 370     match Errors.get_code error with
 371       (* Ignore these errors to match legacy AST behavior *)
 372     | 2086 (* Naming.MethodNeedsVisibility *)
 373     | 2102 (* Naming.UnsupportedTraitUseAs *)
 374     | 2103 (* Naming.UnsupportedInsteadOf *)
 375       -> acc
 376     | _ (* Emit fatal parse otherwise *) ->
 377       if acc = None
 378       then
 379         let msg = snd (List.hd_exn (Errors.to_list error)) in
 380         Some (Errors.get_pos error, msg)
 381       else acc in
 382   let result = Errors.fold_errors ~init:None ~f:handle_error errors in
 383   match result with
 384   | Some error -> Error error
 385   | None -> Ok tast
 386
 387 let do_compile filename compiler_options popt fail_or_ast debug_time =
 388   let t = Unix.gettimeofday () in
 389   let t = add_to_time_ref debug_time.parsing_t t in
 390   let is_js_file = Filename.check_suffix (Relative_path.to_absolute filename) "js" in
 391   let hhas_prog =
 392     match fail_or_ast with
 393     | `ParseFailure (e, pos) ->
 394       let error_t =
 395         match SyntaxError.error_type e with
 396         | SyntaxError.ParseError -> Hhbc_ast.FatalOp.Parse
 397         | SyntaxError.RuntimeError -> Hhbc_ast.FatalOp.Runtime in
 398       let s = SyntaxError.message e in
 399       Emit_program.emit_fatal_program ~ignore_message:false error_t pos s
 400     | `ParseResult (errors, (ast, is_hh_file)) ->
 401       List.iter
 402         (Errors.get_error_list errors)
 403         (fun e -> P.eprintf "%s\n%!" (Errors.to_string (Errors.to_absolute e)));
 404       if Errors.is_empty errors
 405       then
 406         begin match convert_to_tast ast with
 407         | Ok tast ->
 408           Emit_program.from_ast ~is_hh_file ~is_js_file
 409             ~is_evaled:(is_file_path_for_evaled_code filename)
 410             ~for_debugger_eval:(compiler_options.for_debugger_eval)
 411             ~popt
 412             tast
 413         | Error (pos, msg) ->
 414           Emit_program.emit_fatal_program ~ignore_message:false
 415             Hhbc_ast.FatalOp.Parse pos msg
 416         end
 417       else
 418         Emit_program.emit_fatal_program ~ignore_message:true
 419           Hhbc_ast.FatalOp.Parse Pos.none "Syntax error" in
 420   let t = add_to_time_ref debug_time.codegen_t t in
 421   let hhas = Hhbc_hhas.to_segments
 422     ~path:filename
 423     ~dump_symbol_refs:compiler_options.dump_symbol_refs
 424     hhas_prog in
 425   ignore @@ add_to_time_ref debug_time.printing_t t;
 426   if compiler_options.debug_time
 427   then print_debug_time_info filename debug_time;
 428   if compiler_options.log_stats
 429   then log_success compiler_options filename debug_time;
 430   hhas
 431
 432 let extract_facts ?pretty ~filename ~source_root text =
 433   let json_facts = match Hackc_parse_delegator.extract_facts filename source_root with
 434     | Some result -> Some result
 435     | None ->
 436       Facts_parser.extract_as_json
 437         ~php5_compat_mode:true
 438         ~hhvm_compat_mode:true
 439         ~filename ~text
 440   in
 441   (* return empty string if file has syntax errors *)
 442   Option.value_map ~default:"" ~f:(Hh_json.json_to_string ?pretty) json_facts
 443   |> fun x -> [x]
 444
 445 let parse_hh_file filename body =
 446   let file = Relative_path.create Relative_path.Dummy filename in
 447   let source_text = SourceText.make file body in
 448   let syntax_tree = SyntaxTree.make source_text in
 449   let json = SyntaxTree.to_json syntax_tree in
 450   [Hh_json.json_to_string json]
 451
 452 (*****************************************************************************)
 453 (* Main entry point *)
 454 (*****************************************************************************)
 455
 456 let make_popt () =
 457   let open Hhbc_options in
 458   let co = !compiler_options in
 459   ParserOptions.make
 460     ~auto_namespace_map:(aliased_namespaces co)
 461     ~codegen:true
 462     ~disallow_execution_operator:(phpism_disallow_execution_operator co)
 463     ~disable_nontoplevel_declarations:(phpism_disable_nontoplevel_declarations co)
 464     ~disable_static_closures:(phpism_disable_static_closures co)
 465     ~disable_lval_as_an_expression:(disable_lval_as_an_expression co)
 466     ~disable_instanceof:(phpism_disable_instanceof co)
 467     ~rust:(use_rust_parser co)
 468
 469 let process_single_source_unit compiler_options
 470   handle_output handle_exception filename source_text source_root =
 471   try
 472     let popt = make_popt () in
 473     let debug_time = new_debug_time () in
 474     let t = Unix.gettimeofday () in
 475     let output =
 476       if compiler_options.extract_facts
 477       then extract_facts ~pretty:true ~filename ~source_root source_text
 478       else begin
 479         let fail_or_ast =
 480           match Hackc_parse_delegator.parse_file filename source_text source_root with
 481           | Some fail_or_ast -> fail_or_ast
 482           | None -> parse_file compiler_options popt filename source_text
 483         in
 484         ignore @@ add_to_time_ref debug_time.parsing_t t;
 485         do_compile filename compiler_options popt fail_or_ast debug_time
 486       end in
 487     handle_output filename output debug_time
 488   with exc ->
 489     let stack = Caml.Printexc.get_backtrace () in
 490     if compiler_options.log_stats
 491     then log_fail compiler_options filename exc ~stack;
 492     handle_exception filename exc
 493
 494 let decl_and_run_mode compiler_options =
 495   let open Hh_json in
 496   let open Access in
 497
 498   let print_and_flush_strings strings =
 499     List.iter ~f:(P.printf "%s") strings;
 500     P.printf "%!" in
 501
 502   let set_compiler_options config_json =
 503     let options =
 504       Hhbc_options.get_options_from_config
 505         config_json
 506         ~init:!Hhbc_options.compiler_options
 507         ~config_list:compiler_options.config_list
 508     in
 509     Hhbc_options.set_compiler_options options in
 510   let ini_config_json =
 511     Option.map ~f:json_of_file compiler_options.config_file in
 512
 513   set_compiler_options ini_config_json;
 514   let dumped_options = lazy (Hhbc_options.to_string !Hhbc_options.compiler_options) in
 515   Ident.track_names := true;
 516
 517   match compiler_options.mode with
 518     | DAEMON ->
 519       let handle_output filename output debug_time =
 520         let abs_path = Relative_path.to_absolute filename in
 521         let bytes =
 522           List.fold ~f:(fun len s -> len + String.length s) ~init:0 output in
 523         let msg =
 524           [ ("type", JSON_String "success")
 525           ; ("file", JSON_String abs_path)
 526           ; ("bytes", int_ bytes)
 527           ] in
 528         let msg =
 529           if Hhbc_options.enable_perf_logging !Hhbc_options.compiler_options
 530           then
 531             let json_microsec t = int_ @@ int_of_float @@ t *. 1000000.0 in
 532                ("parsing_time", json_microsec !(debug_time.parsing_t))
 533             :: ("codegen_time", json_microsec !(debug_time.codegen_t))
 534             :: ("printing_time", json_microsec !(debug_time.printing_t))
 535             :: msg
 536           else msg
 537         in
 538         P.printf "%s\n" (json_to_string @@ JSON_Object msg);
 539         print_and_flush_strings output in
 540       let handle_exception filename exc =
 541         let abs_path = Relative_path.to_absolute filename in
 542         let msg = json_to_string @@ JSON_Object
 543           [ ("type", JSON_String "error")
 544           ; ("file", JSON_String abs_path)
 545           ; ("error", JSON_String (Caml.Printexc.to_string exc))
 546           ] in
 547         P.printf "%s\n%!" msg in
 548       let handlers =
 549         { set_config = (fun _header body ->
 550           let config_json =
 551             if body = "" then None else Some (json_of_string body) in
 552           set_compiler_options config_json)
 553         ; error = (fun header _body ->
 554           let filename = get_field
 555             (get_string "file")
 556             (fun af -> fail_daemon None ("Cannot determine file name of source unit: " ^ af))
 557             header in
 558           let error = get_field
 559             (get_string "error")
 560             (fun _af -> fail_daemon (Some filename) ("No 'error' field in error message"))
 561             header in
 562           fail_daemon (Some filename) ("Error processing " ^ filename ^ ": " ^ error))
 563         ; compile = (fun header body ->
 564           let filename = get_field
 565             (get_string "file")
 566             (fun af -> fail_daemon None ("Cannot determine file name of source unit: " ^ af))
 567             header in
 568           let for_debugger_eval = get_field
 569             (get_bool "for_debugger_eval")
 570             (fun af -> fail_daemon None ("for_debugger_eval flag missing: " ^ af))
 571             header in
 572           let old_config = !Hhbc_options.compiler_options in
 573           let config_overrides = get_field
 574             (get_obj "config_overrides")
 575             (fun _af -> JSON_Object [])
 576             header in
 577           let source_root = get_field_opt (get_string "root") header in
 578           set_compiler_options (Some config_overrides);
 579           let compiler_options = { compiler_options with for_debugger_eval } in
 580           let result = process_single_source_unit
 581             compiler_options
 582             handle_output
 583             handle_exception
 584             (Relative_path.create Relative_path.Dummy filename)
 585             body
 586             source_root in
 587           Hhbc_options.set_compiler_options old_config;
 588           result)
 589         ; facts = (fun header body -> (
 590           (* if body is empty - read file from disk *)
 591           let filename = get_field
 592             (get_string "file")
 593             (fun af -> fail_daemon None ("Cannot determine file name of source unit: " ^ af))
 594             header in
 595           let source_root = get_field_opt (get_string "root") header in
 596           let body =
 597             if String.length body = 0
 598             then Sys_utils.cat filename
 599             else body in
 600           let path = Relative_path.create Relative_path.Dummy filename in
 601           handle_output
 602             path
 603             (extract_facts ~filename:path ~source_root body))
 604             (new_debug_time ()))
 605         ; parse = (fun header body -> (
 606           let filename = get_field
 607             (get_string "file")
 608             (fun af -> fail_daemon None ("Cannot determine file name of source unit: " ^ af))
 609             header in
 610           let body =
 611             if String.length body = 0
 612             then Sys_utils.cat filename
 613             else body in
 614           handle_output
 615             (Relative_path.create Relative_path.Dummy filename)
 616             (parse_hh_file filename body))
 617             (new_debug_time ()))
 618         } in
 619       dispatch_loop handlers
 620
 621     | CLI ->
 622       let handle_exception filename exc =
 623         if not compiler_options.quiet_mode
 624         then
 625           P.eprintf "Error in file %s: %s\n"
 626             (Relative_path.to_absolute filename)
 627             (Caml.Printexc.to_string exc) in
 628
 629       let process_single_file handle_output filename =
 630         let filename = Relative_path.create Relative_path.Dummy filename in
 631         let abs_path = Relative_path.to_absolute filename in
 632         process_single_source_unit
 633           compiler_options handle_output handle_exception filename (cat abs_path) None in
 634
 635       let filenames, handle_output = match compiler_options.input_file_list with
 636         (* List of source files explicitly given *)
 637         | Some input_file_list ->
 638           let get_lines_in_file filename =
 639             let inch = Caml.open_in filename in
 640             let rec go lines =
 641               match Caml.input_line inch with
 642               | line -> go (Caml.String.trim line :: lines)
 643               | exception End_of_file -> lines in
 644             go [] in
 645           let handle_output _filename output _debug_time =
 646             if compiler_options.dump_config then
 647               Printf.printf "===CONFIG===\n%s\n\n%!" (Lazy.force dumped_options);
 648             if not compiler_options.quiet_mode then
 649               print_and_flush_strings output
 650           in get_lines_in_file input_file_list, handle_output
 651
 652         | None ->
 653           if Sys.is_directory compiler_options.filename
 654
 655           (* Compile every file under directory *)
 656           then
 657             let files_in_dir =
 658               let rec go dirs = match dirs with
 659                 | [] -> []
 660                 | dir :: dirs ->
 661                   let ds, fs = Sys.readdir dir
 662                 |> Array.map ~f:(Filename.concat dir)
 663                 |> Array.to_list
 664                 |> List.partition_tf ~f: Sys.is_directory in
 665                   fs @ go (ds @ dirs) in
 666               go [compiler_options.filename] in
 667             let handle_output filename output _debug_time =
 668               let abs_path = Relative_path.to_absolute filename in
 669               if Filename.check_suffix abs_path ".php" then
 670                 let output_file = Filename.chop_suffix abs_path ".php" ^ ".hhas" in
 671                 if Sys.file_exists output_file
 672                 then (
 673                   if not compiler_options.quiet_mode
 674                   then Caml.Printf.fprintf Caml.stderr "Output file %s already exists\n" output_file)
 675                 else
 676                   Sys_utils.write_strings_to_file ~file:output_file output
 677             in files_in_dir, handle_output
 678
 679           (* Compile a single file *)
 680           else
 681             let handle_output _filename output _debug_time =
 682               match compiler_options.output_file with
 683                 | Some output_file ->
 684                   Sys_utils.write_strings_to_file ~file:output_file output
 685                 | None ->
 686                   if compiler_options.dump_config then
 687                     Printf.printf "===CONFIG===\n%s\n\n%!" (Lazy.force dumped_options);
 688                   if not compiler_options.quiet_mode then
 689                     print_and_flush_strings output
 690             in [compiler_options.filename], handle_output
 691
 692       (* Actually execute the compilation(s) *)
 693       in List.iter filenames (process_single_file handle_output)
 694
 695 let main_hack opts =
 696   let start_time = Unix.gettimeofday () in
 697   if opts.log_stats then Logger.init start_time;
 698   decl_and_run_mode opts
 699
 700 (* command line driver *)
 701 let () =
 702   Printexc.record_backtrace true;
 703   try
 704     if ! Sys.interactive
 705     then ()
 706     else
 707     (* On windows, setting 'binary mode' avoids to output CRLF on
 708        stdout.  The 'text mode' would not hurt the user in general, but
 709        it breaks the testsuite where the output is compared to the
 710        expected one (i.e. in given file without CRLF). *)
 711       Caml.set_binary_mode_out Caml.stdout true;
 712     let handle = SharedMem.init ~num_workers:0 GlobalConfig.default_sharedmem_config in
 713     ignore (handle: SharedMem.handle);
 714     let options = parse_options () in
 715     main_hack options
 716   with exc ->
 717     let stack = Caml.Printexc.get_backtrace () in
 718     prerr_endline stack;
 719     die (Caml.Printexc.to_string exc)