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