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 Hh_prelude
  11 module P = Printf
  12 module SourceText = Full_fidelity_source_text
  13 module SyntaxTree =
  14   Full_fidelity_syntax_tree.WithSyntax (Full_fidelity_positioned_syntax)
  15 module Logger = HackcEventLogger
  16
  17 (*****************************************************************************)
  18 (* Types, constants *)
  19 (*****************************************************************************)
  20 type mode =
  21   | CLI
  22   | DAEMON
  23
  24 let is_mode_cli = function
  25   | CLI -> true
  26   | DAEMON -> false
  27
  28 let is_mode_daemon = function
  29   | CLI -> false
  30   | DAEMON -> true
  31
  32 type options = {
  33   filename: string;
  34   fallback: bool;
  35   config_list: string list;
  36   debug_time: bool;
  37   output_file: string option;
  38   config_file: string option;
  39   mode: mode;
  40   input_file_list: string option;
  41   dump_symbol_refs: bool;
  42   dump_config: bool;
  43   extract_facts: bool;
  44   log_stats: bool;
  45   for_debugger_eval: bool;
  46   (* below are used during Rust porting *)
  47   disable_toplevel_elaboration: bool;
  48   include_header: bool;
  49   (* Experimental *)
  50   dump_desugared_expression_trees: bool;
  51 }
  52
  53 type message_handler = Hh_json.json -> string -> unit
  54
  55 type message_handlers = {
  56   set_config: message_handler;
  57   compile: message_handler;
  58   facts: message_handler;
  59   parse: message_handler;
  60   error: message_handler;
  61 }
  62
  63 (*****************************************************************************)
  64 (* Debug info refs *)
  65 (*****************************************************************************)
  66
  67 type debug_time = {
  68   parsing_t: float ref;
  69   codegen_t: float ref;
  70   printing_t: float ref;
  71 }
  72
  73 let new_debug_time () =
  74   { parsing_t = ref 0.0; codegen_t = ref 0.0; printing_t = ref 0.0 }
  75
  76 let prev_vm_hwm = ref 0
  77
  78 let log_peak_mem file action =
  79   match Memory_stats.get_vm_hwm () with
  80   | Some vm_hwm when vm_hwm > !prev_vm_hwm ->
  81     prev_vm_hwm := vm_hwm;
  82     Logger.log_peak_mem
  83       (Option.value file ~default:"")
  84       (Memory_stats.get_vm_rss () |> Option.value ~default:0)
  85       vm_hwm
  86       action
  87   | _ -> ()
  88
  89 (*****************************************************************************)
  90 (* Helpers *)
  91 (*****************************************************************************)
  92
  93 let die str =
  94   prerr_endline str;
  95   exit 2
  96
  97 let is_file_path_for_evaled_code s =
  98   let s = Relative_path.to_absolute s in
  99   String_utils.string_ends_with s ") : eval()'d code"
 100
 101 let print_compiler_version () =
 102   Hh_json.(
 103     let compiler_version_msg =
 104       json_to_string
 105       @@ JSON_Object
 106            [
 107              ("type", JSON_String "compiler_version");
 108              ("version", JSON_String (Compiler_id.get_compiler_id ()));
 109            ]
 110     in
 111     P.printf "%s\n%!" compiler_version_msg)
 112
 113 let assert_regular_file filename =
 114   if
 115     (not (Sys.file_exists filename))
 116     || Poly.((Unix.stat filename).Unix.st_kind <> Unix.S_REG)
 117   then
 118     raise (Arg.Bad (filename ^ " not a valid file"))
 119
 120 let parse_options () =
 121   let fn_ref = ref None in
 122   let want_version = ref false in
 123   let fallback = ref false in
 124   let debug_time = ref false in
 125   let config_list = ref [] in
 126   let mode = ref CLI in
 127   let output_file = ref None in
 128   let config_file = ref None in
 129   let input_file_list = ref None in
 130   let dump_symbol_refs = ref false in
 131   let extract_facts = ref false in
 132   let dump_config = ref false in
 133   let log_stats = ref false in
 134   let for_debugger_eval = ref false in
 135   let disable_toplevel_elaboration = ref false in
 136   let include_header = ref false in
 137   let dump_desugared_expression_trees = ref false in
 138   let usage =
 139     P.sprintf "Usage: hh_single_compile (%s) filename\n" Sys.argv.(0)
 140   in
 141   let options =
 142     [
 143       ("--version", Arg.Set want_version, " print the version and do nothing");
 144       ("--fallback", Arg.Set fallback, " Enables fallback compilation");
 145       ( "--debug-time",
 146         Arg.Set debug_time,
 147         " Enables debugging logging for elapsed time" );
 148       ("--facts", Arg.Set extract_facts, "Extract facts from the source code.");
 149       ( "-v",
 150         Arg.String (fun str -> config_list := str :: !config_list),
 151         " Configuration: Server.Port=<value> "
 152         ^ "\n"
 153         ^ "\t\tAllows overriding config options passed on a file" );
 154       ( "-c",
 155         Arg.String
 156           (fun str ->
 157             assert_regular_file str;
 158             config_file := Some str),
 159         " Config file in JSON format" );
 160       ( "-o",
 161         Arg.String (fun str -> output_file := Some str),
 162         " Output file. Creates it if necessary" );
 163       ( "--daemon",
 164         Arg.Unit (fun () -> mode := DAEMON),
 165         " Run a daemon which processes Hack source from standard input" );
 166       ( "--input-file-list",
 167         Arg.String (fun str -> input_file_list := Some str),
 168         " read a list of files (one per line) from the file `input-file-list'"
 169       );
 170       ( "--dump-symbol-refs",
 171         Arg.Set dump_symbol_refs,
 172         " Dump symbol ref sections of HHAS" );
 173       ("--dump-config", Arg.Set dump_config, " Dump configuration settings");
 174       ( "--enable-logging-stats",
 175         Arg.Unit (fun () -> log_stats := true),
 176         " Starts logging stats" );
 177       ( "--stop-logging-stats",
 178         Arg.Unit (fun () -> log_stats := false),
 179         " Stop logging stats" );
 180       ( "--for-debugger-eval",
 181         Arg.Unit (fun () -> for_debugger_eval := true),
 182         " Mutate the program as if we're in the debugger repl" );
 183       ( "--disable-toplevel-elaboration",
 184         Arg.Unit (fun () -> disable_toplevel_elaboration := true),
 185         "Disable toplevel definition elaboration" );
 186       ( "--include-header",
 187         Arg.Unit (fun () -> include_header := true),
 188         "Include JSON header" );
 189       ( "--dump-desugared-expression-trees",
 190         Arg.Unit (fun () -> dump_desugared_expression_trees := true),
 191         "Print the source code with expression tree literals desugared. Best effort debugging tool."
 192       );
 193     ]
 194   in
 195   let options = Arg.align ~limit:25 options in
 196   Arg.parse options (fun fn -> fn_ref := Some fn) usage;
 197   if !want_version then (
 198     print_compiler_version ();
 199     exit 0
 200   );
 201   if is_mode_daemon !mode then print_compiler_version ();
 202   let needs_file = Option.is_none !input_file_list in
 203   let fn =
 204     if needs_file then
 205       match !fn_ref with
 206       | Some fn ->
 207         if is_mode_cli !mode then
 208           fn
 209         else
 210           die usage
 211       | None ->
 212         if is_mode_cli !mode then
 213           die usage
 214         else
 215           Caml.read_line ()
 216     else
 217       ""
 218   in
 219   {
 220     filename = fn;
 221     fallback = !fallback;
 222     config_list = !config_list;
 223     debug_time = !debug_time;
 224     output_file = !output_file;
 225     config_file = !config_file;
 226     mode = !mode;
 227     input_file_list = !input_file_list;
 228     dump_symbol_refs = !dump_symbol_refs;
 229     dump_config = !dump_config;
 230     log_stats = !log_stats;
 231     extract_facts = !extract_facts;
 232     for_debugger_eval = !for_debugger_eval;
 233     disable_toplevel_elaboration = !disable_toplevel_elaboration;
 234     include_header = !include_header;
 235     dump_desugared_expression_trees = !dump_desugared_expression_trees;
 236   }
 237
 238 let fail_daemon file error =
 239   Hh_json.(
 240     let file = Option.value ~default:"[unknown]" file in
 241     let msg =
 242       json_to_string
 243       @@ JSON_Object
 244            [
 245              ("type", JSON_String "error");
 246              ("file", JSON_String file);
 247              ("error", JSON_String error);
 248            ]
 249     in
 250     P.printf "%s\n%!" msg;
 251     die error)
 252
 253 let rec dispatch_loop handlers =
 254   Hh_json.(
 255     Access.(
 256       let read_message () =
 257         let line = Caml.read_line () in
 258         let header = json_of_string line in
 259         let file = get_field_opt (get_string "file") header in
 260         let bytes = get_field (get_number_int "bytes") (fun _af -> 0) header in
 261         let body = Bytes.create bytes in
 262         try
 263           Caml.really_input Caml.stdin body 0 bytes;
 264           (header, Bytes.to_string body, file)
 265         with exc ->
 266           fail_daemon
 267             file
 268             ("Exception reading message body: " ^ Caml.Printexc.to_string exc)
 269       in
 270       let (header, body, file) = read_message () in
 271       let msg_type =
 272         get_field
 273           (get_string "type")
 274           (fun af ->
 275             fail_daemon None ("Cannot determine type of message: " ^ af))
 276           header
 277       in
 278       let log_hackc_mem_stats =
 279         get_field_opt (get_bool "log_hackc_mem_stats") header
 280         |> Option.value ~default:false
 281       in
 282       (match msg_type with
 283       | "code" -> handlers.compile header body
 284       | "error" -> handlers.error header body
 285       | "config" -> handlers.set_config header body
 286       | "facts" -> handlers.facts header body
 287       | "parse" -> handlers.parse header body
 288       | _ -> fail_daemon None ("Unhandled message type '" ^ msg_type ^ "'"));
 289       (try if log_hackc_mem_stats then log_peak_mem file msg_type
 290        with exc ->
 291          let stack = Caml.Printexc.get_backtrace () in
 292          Printf.eprintf "%s\n" stack;
 293          fail_daemon
 294            file
 295            ( "Exception reading message body: "
 296            ^ Caml.Printexc.to_string exc
 297            ^ stack ));
 298       dispatch_loop handlers))
 299
 300 let print_debug_time_info filename debug_time =
 301   let stat = Caml.Gc.stat () in
 302   P.eprintf "File %s:\n" (Relative_path.to_absolute filename);
 303   P.eprintf "Parsing: %0.3f s\n" !(debug_time.parsing_t);
 304   P.eprintf "Codegen: %0.3f s\n" !(debug_time.codegen_t);
 305   P.eprintf "Printing: %0.3f s\n" !(debug_time.printing_t);
 306   P.eprintf "MinorWords: %0.3f\n" stat.Caml.Gc.minor_words;
 307   P.eprintf "PromotedWords: %0.3f\n" stat.Caml.Gc.promoted_words
 308
 309 let mode_to_string = function
 310   | CLI -> "CLI"
 311   | DAEMON -> "DAEMON"
 312
 313 let log_success compiler_options filename debug_time =
 314   Logger.success
 315     ~filename:(Relative_path.to_absolute filename)
 316     ~parsing_t:!(debug_time.parsing_t)
 317     ~codegen_t:!(debug_time.codegen_t)
 318     ~printing_t:!(debug_time.printing_t)
 319     ~mode:(mode_to_string compiler_options.mode)
 320
 321 let log_fail compiler_options filename exc ~stack =
 322   Logger.fail
 323     ~filename:(Relative_path.to_absolute filename)
 324     ~mode:(mode_to_string compiler_options.mode)
 325     ~exc:(Caml.Printexc.to_string exc ^ "\n" ^ stack)
 326
 327 let print_output
 328     (bytecode : string list)
 329     (config : Compile_ffi.rust_output_config)
 330     (file : Relative_path.t)
 331     (debug_time : debug_time option)
 332     (log_config_json : bool)
 333     (config_jsons : string list)
 334     (config_list : string list) =
 335   let write =
 336     match config.Compile_ffi.output_file with
 337     | Some file -> Sys_utils.write_strings_to_file ~file
 338     | None ->
 339       fun c ->
 340         List.iter ~f:(P.printf "%s") c;
 341         P.printf "%!"
 342   in
 343   if config.Compile_ffi.include_header then (
 344     let bytes =
 345       List.fold ~f:(fun len s -> len + String.length s) ~init:0 bytecode
 346     in
 347     let abs_path = Relative_path.to_absolute file in
 348     let msg =
 349       Hh_json.
 350         [
 351           ("bytes", int_ bytes);
 352           ("file", JSON_String abs_path);
 353           ("type", JSON_String "success");
 354         ]
 355     in
 356     let msg =
 357       if
 358         log_config_json
 359         || String.is_suffix
 360              (Relative_path.to_absolute file)
 361              "HACKC_LOG_OPTS.php"
 362       then
 363         ( "config_jsons",
 364           Hh_json.JSON_Array
 365             (List.map
 366                ~f:(fun x -> Hh_json.JSON_String x)
 367                (config_jsons @ config_list)) )
 368         :: msg
 369       else
 370         msg
 371     in
 372     let msg =
 373       match debug_time with
 374       | Some debug_time ->
 375         let json_microsec t =
 376           Hh_json.int_ @@ int_of_float @@ (t *. 1000000.0)
 377         in
 378         ("parsing_time", json_microsec !(debug_time.parsing_t))
 379         :: ("codegen_time", json_microsec !(debug_time.codegen_t))
 380         :: ("printing_time", json_microsec !(debug_time.printing_t))
 381         :: msg
 382       | None -> msg
 383     in
 384     write Hh_json.[json_to_string @@ JSON_Object msg];
 385     write ["\n"]
 386   );
 387   write bytecode
 388
 389 let do_compile
 390     ~is_systemlib
 391     ~config_jsons
 392     (compiler_options : options)
 393     rust_output_config
 394     filename
 395     source_text =
 396   (* dummy line to load Full_fidelity_ast *)
 397   let _ = Full_fidelity_ast.make_env filename in
 398   let env =
 399     Compile_ffi.
 400       {
 401         re_filepath = filename;
 402         re_config_jsons = List.rev config_jsons;
 403         re_config_list = compiler_options.config_list;
 404         re_flags =
 405           ( ( if is_systemlib then
 406               1
 407             else
 408               0 )
 409           lor ( if is_file_path_for_evaled_code filename then
 410                 2
 411               else
 412                 0 )
 413           lor ( if compiler_options.for_debugger_eval then
 414                 4
 415               else
 416                 0 )
 417           lor ( if compiler_options.dump_symbol_refs then
 418                 8
 419               else
 420                 0 )
 421           lor
 422           if compiler_options.disable_toplevel_elaboration then
 423             16
 424           else
 425             0 );
 426       }
 427   in
 428   match Compile_ffi.rust_from_text_ffi env rust_output_config source_text with
 429   | Ok () -> ()
 430   | Error msg -> raise (Failure msg)
 431
 432 let extract_facts ~compiler_options ~config_jsons ~filename text =
 433   let (co, log_config_json) =
 434     Hhbc_options.apply_config_overrides_statelessly
 435       compiler_options.config_list
 436       config_jsons
 437   in
 438   ( [
 439       Hhbc_options.(
 440         Facts_parser.extract_as_json_string
 441           ~php5_compat_mode:true
 442           ~hhvm_compat_mode:true
 443           ~disable_nontoplevel_declarations:
 444             (phpism_disable_nontoplevel_declarations co)
 445           ~disable_legacy_soft_typehints:(disable_legacy_soft_typehints co)
 446           ~allow_new_attribute_syntax:(allow_new_attribute_syntax co)
 447           ~disable_legacy_attribute_syntax:(disable_legacy_attribute_syntax co)
 448           ~enable_xhp_class_modifier:(enable_xhp_class_modifier co)
 449           ~disable_xhp_element_mangling:(disable_xhp_element_mangling co)
 450           ~disallow_hash_comments:(disallow_hash_comments co)
 451           ~filename
 452           ~text
 453         |> Option.value ~default:"");
 454     ],
 455     co,
 456     log_config_json )
 457
 458 let parse_hh_file ~config_jsons ~compiler_options filename body =
 459   let (co, log_config_json) =
 460     Hhbc_options.apply_config_overrides_statelessly
 461       compiler_options.config_list
 462       config_jsons
 463   in
 464   Hhbc_options.(
 465     let file = Relative_path.create Relative_path.Dummy filename in
 466     let source_text = SourceText.make file body in
 467     let mode = Full_fidelity_parser.parse_mode source_text in
 468     let env =
 469       Full_fidelity_parser_env.make
 470         ~codegen:true
 471         ~php5_compat_mode:true
 472         ~hhvm_compat_mode:true
 473         ~disable_nontoplevel_declarations:
 474           (phpism_disable_nontoplevel_declarations co)
 475         ~disable_legacy_soft_typehints:(disable_legacy_soft_typehints co)
 476         ~allow_new_attribute_syntax:(allow_new_attribute_syntax co)
 477         ~disable_legacy_attribute_syntax:(disable_legacy_attribute_syntax co)
 478         ~enable_xhp_class_modifier:(enable_xhp_class_modifier co)
 479         ~disable_xhp_element_mangling:(disable_xhp_element_mangling co)
 480         ~disallow_hash_comments:(disallow_hash_comments co)
 481         ~disallow_fun_and_cls_meth_pseudo_funcs:
 482           (disallow_fun_and_cls_meth_pseudo_funcs co)
 483         ~disallow_inst_meth:(disallow_inst_meth 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], co, log_config_json))
 490
 491 (*****************************************************************************)
 492 (* Main entry point *)
 493 (*****************************************************************************)
 494
 495 let process_single_source_unit
 496     ~is_systemlib
 497     ~config_jsons
 498     compiler_options
 499     rust_output_config
 500     handle_exception
 501     filename
 502     source_text =
 503   try
 504     if compiler_options.extract_facts then
 505       let (output, _, log_config_json) =
 506         extract_facts ~compiler_options ~config_jsons ~filename source_text
 507       in
 508       print_output
 509         output
 510         rust_output_config
 511         filename
 512         None
 513         log_config_json
 514         config_jsons
 515         compiler_options.config_list
 516     else
 517       do_compile
 518         ~is_systemlib
 519         ~config_jsons
 520         compiler_options
 521         rust_output_config
 522         filename
 523         (Full_fidelity_source_text.make filename source_text)
 524   with exc ->
 525     let stack = Caml.Printexc.get_backtrace () in
 526     if compiler_options.log_stats then
 527       log_fail compiler_options filename exc ~stack;
 528     handle_exception filename exc
 529
 530 let desugar_and_print_expr_trees
 531     ~config_jsons ~compiler_options (filename : string) : unit =
 532   let rel_path = Relative_path.create Relative_path.Dummy filename in
 533   let env =
 534     Compile_ffi.
 535       {
 536         re_filepath = rel_path;
 537         re_config_jsons = List.rev config_jsons;
 538         re_config_list = compiler_options.config_list;
 539         re_flags =
 540           ( ( if is_file_path_for_evaled_code rel_path then
 541               2
 542             else
 543               0 )
 544           lor ( if compiler_options.for_debugger_eval then
 545                 4
 546               else
 547                 0 )
 548           lor ( if compiler_options.dump_symbol_refs then
 549                 8
 550               else
 551                 0 )
 552           lor
 553           if compiler_options.disable_toplevel_elaboration then
 554             16
 555           else
 556             0 );
 557       }
 558   in
 559   Compile_ffi.desugar_and_print_expr_trees env
 560
 561 let decl_and_run_mode compiler_options =
 562   Hh_json.(
 563     Access.(
 564       (* list of pending config JSONs *)
 565       let config_jsons = ref [] in
 566       let add_config (config_json : string option) =
 567         config_jsons := config_json :: !config_jsons
 568       in
 569       let pop_config () =
 570         config_jsons :=
 571           match !config_jsons with
 572           | _ :: old_config_jsons -> old_config_jsons
 573           | _ -> !config_jsons
 574       in
 575       let get_config_jsons () = List.filter_map ~f:(fun x -> x) !config_jsons in
 576       let ini_config_json : string option =
 577         Option.map
 578           ~f:(fun path -> (try Sys_utils.cat path with _ -> ""))
 579           compiler_options.config_file
 580       in
 581       add_config ini_config_json;
 582       Ident.track_names := true;
 583
 584       match compiler_options.mode with
 585       | DAEMON ->
 586         let add_config_overrides header =
 587           let config_overrides =
 588             get_field
 589               (get_obj "config_overrides")
 590               (fun _af -> JSON_Object [])
 591               header
 592             |> Hh_json.json_to_string
 593           in
 594           add_config (Some config_overrides)
 595         in
 596         let get_filename_and_path (header : json) =
 597           let filename =
 598             get_field
 599               (get_string "file")
 600               (fun af ->
 601                 fail_daemon
 602                   None
 603                   ("Cannot determine file name of source unit: " ^ af))
 604               header
 605           in
 606           (filename, Relative_path.create Relative_path.Dummy filename)
 607         in
 608         let body_or_file_contents (body : string) (filename : string) =
 609           (* if body is empty - read file from disk *)
 610           if String.length body = 0 then
 611             Sys_utils.cat filename
 612           else
 613             body
 614         in
 615         let handle_output
 616             filename
 617             output
 618             hhbc_options
 619             log_config_json
 620             compiler_options
 621             debug_time =
 622           print_output
 623             output
 624             Compile_ffi.{ include_header = true; output_file = None }
 625             filename
 626             ( if Hhbc_options.log_extern_compiler_perf hhbc_options then
 627               Some debug_time
 628             else
 629               None )
 630             log_config_json
 631             (get_config_jsons ())
 632             compiler_options.config_list
 633         in
 634         let handle_exception filename exc =
 635           let abs_path = Relative_path.to_absolute filename in
 636           let msg =
 637             json_to_string
 638             @@ JSON_Object
 639                  [
 640                    ("type", JSON_String "error");
 641                    ("file", JSON_String abs_path);
 642                    ("error", JSON_String (Caml.Printexc.to_string exc));
 643                  ]
 644           in
 645           P.printf "%s\n%!" msg
 646         in
 647         let handlers =
 648           {
 649             set_config =
 650               (fun _header body ->
 651                 let config_json =
 652                   if String.is_empty body then
 653                     None
 654                   else
 655                     Some body
 656                 in
 657                 add_config config_json);
 658             error =
 659               (fun header _body ->
 660                 let (filename, _) = get_filename_and_path header in
 661                 let error =
 662                   get_field
 663                     (get_string "error")
 664                     (fun _af ->
 665                       fail_daemon
 666                         (Some filename)
 667                         "No 'error' field in error message")
 668                     header
 669                 in
 670                 fail_daemon
 671                   (Some filename)
 672                   ("Error processing " ^ filename ^ ": " ^ error));
 673             compile =
 674               (fun header body ->
 675                 let (_, path) = get_filename_and_path header in
 676                 let is_systemlib =
 677                   get_field_opt (get_bool "is_systemlib") header
 678                   |> Option.value ~default:false
 679                 in
 680                 let for_debugger_eval =
 681                   get_field
 682                     (get_bool "for_debugger_eval")
 683                     (fun af ->
 684                       fail_daemon None ("for_debugger_eval flag missing: " ^ af))
 685                     header
 686                 in
 687                 add_config_overrides header;
 688                 let compiler_options =
 689                   { compiler_options with for_debugger_eval }
 690                 in
 691                 let result =
 692                   process_single_source_unit
 693                     ~is_systemlib
 694                     ~config_jsons:(get_config_jsons ())
 695                     compiler_options
 696                     Compile_ffi.{ include_header = true; output_file = None }
 697                     handle_exception
 698                     path
 699                     body
 700                 in
 701                 pop_config ();
 702                 result);
 703             facts =
 704               (fun header body ->
 705                 (let (filename, path) = get_filename_and_path header in
 706                  let body = body_or_file_contents body filename in
 707                  add_config_overrides header;
 708                  let (output, hhbc_options, log_config_json) =
 709                    extract_facts
 710                      ~compiler_options
 711                      ~config_jsons:(get_config_jsons ())
 712                      ~filename:path
 713                      body
 714                  in
 715                  let result =
 716                    handle_output
 717                      path
 718                      output
 719                      hhbc_options
 720                      log_config_json
 721                      compiler_options
 722                  in
 723                  pop_config ();
 724                  result)
 725                   (new_debug_time ()));
 726             parse =
 727               (fun header body ->
 728                 (let (filename, path) = get_filename_and_path header in
 729                  let body = body_or_file_contents body filename in
 730                  add_config_overrides header;
 731                  let (output, hhbc_options, log_config_json) =
 732                    parse_hh_file
 733                      ~config_jsons:(get_config_jsons ())
 734                      ~compiler_options
 735                      filename
 736                      body
 737                  in
 738                  let result =
 739                    handle_output
 740                      path
 741                      output
 742                      hhbc_options
 743                      log_config_json
 744                      compiler_options
 745                  in
 746                  pop_config ();
 747                  result)
 748                   (new_debug_time ()));
 749           }
 750         in
 751         dispatch_loop handlers
 752       | CLI ->
 753         let handle_exception filename exc =
 754           let stack = Caml.Printexc.get_backtrace () in
 755           prerr_endline stack;
 756           P.eprintf
 757             "Error in file %s: %s\n"
 758             (Relative_path.to_absolute filename)
 759             (Caml.Printexc.to_string exc)
 760         in
 761         let process_single_file output_file filename_str =
 762           let filename =
 763             Relative_path.create Relative_path.Dummy filename_str
 764           in
 765           (* let abs_path = Relative_path.to_absolute filename in *)
 766           let files = Multifile.file_to_file_list filename in
 767           List.iter files ~f:(fun (filename, content) ->
 768               process_single_source_unit
 769                 ~is_systemlib:false
 770                 ~config_jsons:(get_config_jsons ())
 771                 compiler_options
 772                 Compile_ffi.
 773                   {
 774                     include_header = compiler_options.include_header;
 775                     output_file;
 776                   }
 777                 handle_exception
 778                 filename
 779                 content);
 780           if compiler_options.log_stats then
 781             log_peak_mem (Some filename_str) "compile"
 782         in
 783         let (filenames, output_file) =
 784           match compiler_options.input_file_list with
 785           (* List of source files explicitly given *)
 786           | Some input_file_list ->
 787             let get_lines_in_file filename =
 788               let inch = Caml.open_in filename in
 789               let rec go lines =
 790                 match Caml.input_line inch with
 791                 | line -> go (Caml.String.trim line :: lines)
 792                 | exception End_of_file -> lines
 793               in
 794               go []
 795             in
 796             (get_lines_in_file input_file_list, None)
 797           | None -> ([compiler_options.filename], compiler_options.output_file)
 798           (* Actually execute the compilation(s) *)
 799         in
 800         if compiler_options.dump_config then
 801           Printf.printf
 802             "===CONFIG===\n%s\n\n%!"
 803             ( Hhbc_options.apply_config_overrides_statelessly
 804                 compiler_options.config_list
 805                 (get_config_jsons ())
 806             |> fst
 807             |> Hhbc_options.to_string );
 808         if
 809           (not (String.is_empty compiler_options.filename))
 810           && Sys.is_directory compiler_options.filename
 811         then
 812           P.eprintf
 813             "%s is a directory, directory is not supported."
 814             compiler_options.filename
 815         else
 816           let process_fn =
 817             if compiler_options.dump_desugared_expression_trees then
 818               desugar_and_print_expr_trees
 819                 ~config_jsons:(get_config_jsons ())
 820                 ~compiler_options
 821             else
 822               process_single_file output_file
 823           in
 824           List.iter filenames process_fn))
 825
 826 let main_hack opts =
 827   let start_time = Unix.gettimeofday () in
 828   if opts.log_stats then Logger.init_sync start_time;
 829   decl_and_run_mode opts
 830
 831 (* command line driver *)
 832 let () =
 833   Printexc.record_backtrace true;
 834   try
 835     if !Sys.interactive then
 836       ()
 837     else
 838       (* On windows, setting 'binary mode' avoids to output CRLF on
 839        stdout.  The 'text mode' would not hurt the user in general, but
 840        it breaks the testsuite where the output is compared to the
 841        expected one (i.e. in given file without CRLF). *)
 842       Caml.set_binary_mode_out Caml.stdout true;
 843     let handle = SharedMem.init ~num_workers:0 SharedMem.empty_config in
 844     ignore (handle : SharedMem.handle);
 845     let options = parse_options () in
 846     main_hack options
 847   with exc ->
 848     let stack = Caml.Printexc.get_backtrace () in
 849     prerr_endline stack;
 850     die (Caml.Printexc.to_string exc)