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