Skip to content
This repository
tree: ee7b4361a2
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 844 lines (722 sloc) 33.818 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)

(**
Command line options and Static Parameters for opa.exe.

wip, some clean-up is needed (deprecated options, sharing with qml2ocaml, etc...)

@author Cédric Soulas
@author Mathieu Barbin
@author Mehdi Bouaziz
*)

(* depends *)
module Arg = Base.Arg
module Format = BaseFormat
module String = BaseString

(* - *)

module Parameters =
struct

  let bsl_client_language = BslLanguage.js
  let bsl_server_language = BslLanguage.ml

  (** ==============================================*)
  (** COMPILATION OF SERVERS WITH OCAML *)

  (** the following values are modifiable with the opa options *)
  let ocamlopt = "ocamlopt.opt"
  let ocamlc = "ocamlc.opt"

  (** the other values are not mutable -- cf opa options -I -x to add some more libraries *)
  (** these parameters are DEFINED and DOCUMENTED in qml2llvm/qml2ocaml/qml2ocamlOptions.ml *)
  include Qml2ocamlOptions.StaticParameters

(** ==============================================*)
end

module I18n = struct
  let template_message ext = Printf.sprintf " Generate %s source code template as translation package, use --i18n-pkg to specify the output file name and corresponding opa package name" ext

  module Type = struct
    type options = {
      template_opa : bool;
      template_po : bool;
      pkg : string list;
      dir : string list;
    }
  end

  include Type

  let default_options = {
    template_opa = false;
    template_po = false;
    pkg = [] ;
    dir = [] ;
  }

  let r = ref default_options

  let options = [
    "--i18n-template-opa",
    Arg.Unit (fun () -> r := {!r with template_opa=true}),
    template_message "opa";

    "--i18n-template-po",
    Arg.Unit (fun () -> r := {!r with template_po=true}) ,
    template_message "po";

    "--i18n-pkg",
    Arg.String (fun str -> r := {!r with pkg = str :: (!r.pkg)}),
    " Use the explicitely give package name for i18n";

    "--i18n-dir",
    Arg.String (fun str -> r := {!r with dir = str :: (!r.dir)}),
    " Specify the directory containing translations";

  ]

end

let cwd = Sys.getcwd ()

let available_js_back_end_list = Qml2jsOptions.backend_names ()
let available_js_back_end_of_string = Qml2jsOptions.find_backend

type available_back_end = [ `qmlflat ]
let available_back_end_list = [ "qmlflat" ]
let available_back_end_of_string : string -> available_back_end option = function
  | "qmlflat" -> Some `qmlflat
  | _ -> None
let string_of_available_back_end : available_back_end -> string = function
  | `qmlflat -> "qmlflat"

type opa_options = {

  ocamlc : string ;
  ocamlopt : string ;

  ccopt : string list ;
  cclib : string list ;

  mlcopt : string list ;
  mllopt : string list ;

  makefile_rule : Qml2ocamlOptions.makefile_rule ;
  back_end : available_back_end ;
  js_back_end : (module Qml2jsOptions.JsBackend) ;
  hacker_mode : bool ;

  filenames : string list;
  show_types : bool ;

  (* n *)

  no_assert : bool ;

  no_server : bool option ; (* None means "look if there is a server declaration"
* Some true means "no server"
* Some false means "with a server" *)
  stdlib : bool ;
  embedded_opa : bool ;

  show_compilation : bool ;
  no_cache_parse : bool ;
  no_discard_of_unused_stdlib : bool ;
  cps : bool ;
  cps_client : bool ;
  cps_toplevel_concurrency : bool ;
  closure : bool ;
  extralibs : string list ;
  extrajs : (string * BslJsConf.conf) list ;
  extrapath : string list ;
  resname : string ;
  target : string ;
  explicit_instantiation : bool ;
  value_restriction : [`disabled|`normal|`strict] ;
  dump_dbgen_schema : string option ;
  bypass_plugin : string list ;
  compile_release:bool;
  run_server_options : string list option;
  build_dir : string;
  slicer_test : bool;
  slicer_dump : bool;
  rpc_options : int * int * int;

  profile : bool;
  mime_database : string option;
  project_root : string;
  root_inclusions : string option;
  undot : bool;
  generate_interface : bool;
  generate_interface_and_compile : bool;
  js_serialize : [`adhoc|`ast];
  constant_sharing : bool;
  constant_sharing_client : bool;
  js_check_bsl_types : bool;
  js_cleanup : bool;
  js_local_inlining : bool;
  js_global_inlining : bool;
  js_local_renaming : bool;
  publish_src_code : bool; (** if true, application source code will be published at [_internal_/src_code] *)

  i18n : I18n.options ;
}

let i18n_template option = option.i18n.I18n.template_opa || option.i18n.I18n.template_po

module Options :
sig
  val parse_options : unit -> unit
  val get_options : unit -> opa_options
  val echo_help : unit -> unit

  (** Fill a pprocess environment from opa options. *)
  val to_ppenv : opa_options -> Pprocess.env -> Pprocess.env

end
=
struct

  module ArgParser =
  struct
    module Env =
    struct
      let ocamlopt = ref (lazy Parameters.ocamlopt)
      let ocamlc = ref (lazy Parameters.ocamlc)

      let envvar =
        [
          "OCAMLOPT", "Path of the ocaml native compiler, e.g. ocamlopt, ocamlopt.opt, /usr/local/bin/ocamlopt ...", ocamlopt;
        ]

      let set =
        List.iter (
          fun (v, _, ref_)->
            try
              let res = Sys.getenv v in
              ref_ := lazy res
            with Not_found -> ()
        )
          envvar
    end
    let hacker_mode = ref false
    let run_server_options = ref None
    let print_help = ref false
    let explicit_instantiation = ref true
    let value_restriction = ref `normal
    let target_only_qml = ref "only_qml.qml"
    let target = ref ""
    let show_types = ref false

    (* n *)

    let no_assert = ref false
    let no_server = ref None

    let stdlib = ref true
    let show_compilation = ref false
    let no_cache_parse = ref false
    let no_discard_of_unused_stdlib = ref false
    let cps = ref true
    let cps_client = ref false
    let cps_toplevel_concurrency = ref false
    let closure = ref true
    let embedded_opa = ref true
    let build_dir = ref ""
    let makefile_rule = ref Qml2ocamlOptions.Native
    let opa_walker = ref None
    let profile = ref false
    let slicer_test = ref false
    let slicer_dump = ref false
    let rpc_options = ref (1,0,0)
    let mime_database = ref None
    let project_root = ref cwd
    let root_inclusions = ref None
    let undot = ref true
    let generate_interface = ref false
    let generate_interface_and_compile = ref false
    let js_serialize = ref `adhoc

    let constant_sharing = ref true
    let constant_sharing_client = ref false

    let js_check_bsl_types = ref false
    let js_cleanup = ref true
    let js_local_inlining = ref true
    let js_global_inlining = ref true
    let js_local_renaming = ref true
    (* in release, force publishing source code ; otherwise, don't
publish unless --publish-src-code). *)
    let publish_src_code = ref false

    let back_end_wanted = ref ( `qmlflat : available_back_end )
    let back_end s =
      let back_end =
        match available_back_end_of_string s with
        | None -> assert false (* use symbol in Arg.parse *)
        | Some back_end -> back_end in
      back_end_wanted := back_end
    let js_back_end_wanted_name = "qmljsimp"
    let js_back_end_wanted = ref (available_js_back_end_of_string js_back_end_wanted_name)
    let js_back_end s =
      js_back_end_wanted := available_js_back_end_of_string s

    let dump_dbgen_schema = ref false
    let target_qmli = ref ""
    let target_dbgen_schema = ref ""

    let compile_release = ref false
    let target_opt = ref None
    let gen_change_target target fct s =
(* let s = (File.chop_extension s)^".exe" in *)
      target := fct s
    let change_target = gen_change_target target_opt (fun t -> Some t)
    let last_target_from_file = ref "a"
    let change_last_file s =
      gen_change_target last_target_from_file (fun t -> t) (File.chop_extension s)

    let filenames = ref []
    let mutable_filenames = MutableList.create ()
    let add_any_file f =
      if Sys.file_exists f && not (Sys.is_directory f) then (change_last_file f; MutableList.add mutable_filenames f)
      else OManager.error "I/O error: @{<bright>%S@} -> No such file or directory" f
    let add_opa_file f =
      if File.extension f = "opa" then add_any_file f
      else OManager.error (
        "I don't know what to do with file @{<bright>%S@}@\n"^^
        "@[<2>@{<bright>Hint@}:@\n"^^
        "Use option @{<bright>-impl@} if that is really an opa source@]" )
        f

    let extra_split g =
      List.map String.trim (String.slice_chars "{} ,;'" g)

    (** lib & js for ocaml compilation *)
    let ccopt = MutableList.create ()
    let cclib = MutableList.create ()
    let mlcopt = MutableList.create ()
    let mllopt = MutableList.create ()

    let add_ccopt f = List.iter (MutableList.add ccopt) (extra_split f)
    let add_cclib f = List.iter (MutableList.add cclib) (extra_split f)
    let add_mlcopt f = List.iter (MutableList.add mlcopt) (extra_split f)
    let add_mllopt f = List.iter (MutableList.add mllopt) (extra_split f)

    let extralibs = ref []
    let mutable_extralibs = MutableList.create ()
    let extrajs = ref []
    let add_extra_lib f =
      let ext = File.extension f in
      let expected = [""; "cmxa"; "cma"; "cmo"; "cmx"] in
      if List.mem ext expected then
        MutableList.add mutable_extralibs f
      else
        OManager.error (
          "I don't know what to do with arg @{<bright>%S@}@\n"^^
          "@[<2>@{<bright>Hint@}:@\n"^^
          "expected extensions for @{<bright>--extra-lib@} are {%a}@]"
        )
          f
          (Format.pp_list ", " (fun fmt -> Format.fprintf fmt "%S")) expected

    let set_project_root dir =
        try
            if Sys.is_directory dir then
              begin
                if Filename.is_relative dir then
                  project_root := Filename.concat (Unix.getcwd ()) dir
                else
                  project_root := dir
                ;
                OManager.verbose "Setting project root to %s" !project_root;
              end
            else
                OManager.error "I/O error: @{<bright>%S@} -> No such directory" dir
        with Sys_error _ ->
                OManager.error "I/O error: @{<bright>%S@} -> No such directory" dir

    let set_root_inclusions dir = root_inclusions := Some dir

    let set_mime_database f =
        if Sys.file_exists f && not (Sys.is_directory f) then
            if File.extension f = "xml" then
                mime_database := Some f
            else
                OManager.error "%S : Bad extension. Given file must be a .xml file" f
        else
          OManager.error "I/O error: @{<bright>%S@} -> No such file or directory" f


    let add_full_extra_lib s = List.iter add_extra_lib (extra_split s)

    (** plugin for bypass : needed and dynlinked by opa, not by the ocaml compilation *)
    let bypass_plugin = ref []
    let mutable_bypass_plugin = MutableList.create ()
    let plugin_inclusion file = MutableList.add mutable_bypass_plugin file

    (** path for ocaml compilation *)
    let extrapath = ref []
    let mutable_extrapath = MutableList.create ()
    let existing_dir d = Sys.file_exists d && Sys.is_directory d
    let add_extra_path p =
      if p.[0] <> '+' && not (existing_dir p)
      then OManager.error "Option --extra-path %S\nNo such file or directory" p
      else MutableList.add mutable_extrapath p

    let add_full_extra_path s = List.iter add_extra_path (extra_split s)

    let str_version =
      Printf.sprintf (
        "Opa compiler (c) MLstate -- version %s -- build %d"
      )
        BuildInfos.opa_version_name
        BuildInfos.opalang_git_version

    let print_version () = prerr_endline str_version

    let rpc_doc =
      "(i,p,c) Different level for RPC optimization (i : server values inserted on client code, p : published functions, c : rpc call)"

    let set_rpc_options str =
      try
        Scanf.sscanf str
          "(%d,%d,%d)"
          (fun i p c -> rpc_options := (i,p,c))
      with Failure _ | End_of_file | Scanf.Scan_failure _ ->
        OManager.error "An error occured while parsing rpc options@\n%s" rpc_doc

    (* ===== *)
    (** Options which refers to (and so depends on, ...) options *)
    let full_help = ref (fun () -> ())

    let help_menu speclist () =
      let head = Printf.sprintf
                    "---- OPA Compiler Help ----
Syntax is :

\"opa.exe [options] source1.opa [source2.opa ...]\"

where options are :
" in
      Arg.usage speclist head;
      if not BuildInfos.is_release
      then (
        prerr_endline "\nYou can set the following environment variables if needed (VAR MEANING DEFAULT):\n" ;
        List.iter (fun (var, mess, _)-> prerr_endline (Printf.sprintf " %s \t-- %s" (String.escaped var) mess)) Env.envvar ;
      ) ;
      prerr_endline "\n-----------------------------\n"

    let do_print_help () = !full_help ()
    let opack_file_function =
      ref (fun s -> OManager.error "--opack %s : you cannot use option @{<bright>--opack@} in a opack file !" s)
    (* use a ref because of recursive dependencies
(the function is updated just after the definition of the options list) *)
      (* ===== *)

    let parse () =
      let standard = (* Please preverse the alphabetical order for lisibility *)
        OManager.Arg.options @
        WarningClass.Arg.options () @
        ObjectFiles.Arg.public_options @
        I18n.options @
        [
          (* a *)
          "--api",
          Arg.Set generate_interface_and_compile,
          " Generate interfaces (json and text) and continue compilation"
          ;

          "--api-only",
          Arg.Set generate_interface,
          " Generate interfaces (json and text) and exit"
          ;

          (* ("--back-end", Arg.Symbol (available_back_end_list, back_end), (sprintf " Select a backend between %s (default is %s) [EXPERIMENTAL]" (String.concat ", " available_back_end_list) (string_of_available_back_end !back_end_wanted))); *)

          (* b *)
          "--build-dir",
          Arg.String (fun s -> build_dir := s),
          " set the build directory : default is _build. You must set an absolute path."
          ;

          (* c *)
          "--ccopt",
          Arg.String add_ccopt,
          "<opt> Pass option <opt> to the C compiler and linker"
          ;

          "--cclib",
          Arg.String add_cclib,
          "<opt> Pass option <opt> to the C linker"
          ;

          ("--compile-release", Arg.Set compile_release, " use this option to make a release : errors should be ignored, activate static file embedding.");
          ("--constant-sharing", Arg.Set constant_sharing, " Activate the constant sharing pass");
          ("--constant-sharing-client", Arg.Set constant_sharing, " Activate the constant sharing pass on javascript code");
          ("--no-constant-sharing", Arg.Clear constant_sharing, " Deactivate the constant sharing pass");
          ("--no-constant-sharing-client", Arg.Clear constant_sharing, " Deactivate the constant sharing pass on javascript code");
          ("--dump-dbgen-schema", Arg.Set dump_dbgen_schema, " Dump the inferred dbgen schema (to files %.dot and %.png)");
          ("--extra-lib", Arg.String add_full_extra_lib, "\"*.cm*,*.js,...\" Add lib(s) to link the generated server");
          ("--extra-path", Arg.String add_full_extra_path, "\"dir,...\" Add path(s) to link the generated server");
          ("-impl", Arg.String add_any_file, "<file> Take <file> as a .opa file");
          ("--js-check-bsl-types", Arg.Set js_check_bsl_types, " Enables runtime type checking of the types of bypasses");

          (* m *)

          "--minimal-version",
          Arg.String (fun s ->
                        match BuildInfos.assert_minimal_version s with
                        | None ->
                            OManager.error (
                              "option --minimal-version: @{<bright>%s@} not recognized@\n"^^
                              "@[<2>@{<bright>Hint@}:@\n"^^
                              "try e.g. S3.%%d, v%%d, or %%d@]"
                            )
                              s
                        | Some false ->
                            OManager.error (
                              "@[<2>This application needs a more recent version of Opa@\n"^^
                              "Required version: %s or later@\n"^^
                              "Current version: %s/%d@]"
                            )
                              s
                              BuildInfos.opa_version_name
                              BuildInfos.opalang_git_version
                        | Some true -> ()
                     ),
          "<version> Ensure that the compiler is newer than the given version"
          ;

          "--mlcopt",
          Arg.String add_mlcopt,
          "<opt> Give option to ocaml compilation"
          ;

          "--mllopt",
          Arg.String add_mllopt,
          "<opt> Give option to ocaml linking"
          ;

          (* n *)

          "--no-assert",
          Arg.Set no_assert,
          " Ignore @assert directives. (e.g. for a release)"
          ;

          ("--no-server", Arg.Unit (fun () -> no_server := Some true), " Executable will not start a server service");
          ("--force-server", Arg.Unit (fun () -> no_server := Some false), " Force the compile to execute passes that are meaningless without server");
          ("--no-stdlib", Arg.Tuple [Arg.Clear stdlib], " Do not use standard libraries");

          ("-o", Arg.String change_target, "<file> Set output file name to <file>");
          ("--opack", Arg.String (fun s -> (!opack_file_function) s), "<opack-file> Use an options-packaging file");
          ("--project-root", Arg.String set_project_root, " Specify the root directory of the project");
          ("--publish-src-code", Arg.Set publish_src_code, " Publish application src code at [_internal_/src_code]");
          ("--root-inclusions", Arg.String set_root_inclusions, "<root> Specify the root directory of static inclusions");
          ("--set-mime-database", Arg.String set_mime_database, " Consider given mime database for detecting mimetypes. Used with the directive @static_include_directory");
          ("--show-types", Arg.Set show_types, " Show types of declarations (L0 elements)");
          ("--slicer-dump", Arg.Set slicer_dump ," Dumps a file containing the side of identifiers and the remote calls they make");
          ("--version", Arg.Unit (fun () -> print_version (); exit 0), " Print version and exit");
          ("--", Arg.Tuple [Arg.Unit (fun ()-> run_server_options:= Some []);
                                Arg.Rest (fun s ->
                                  run_server_options:= (Some (s::(Option.default [] (!run_server_options)))))], " run the compiled server with all remaining options");
          (* Shorthand and synonym (sorted alphabetically) *)
          ("-I", Arg.String add_full_extra_path, " Shorthand for \"--extra-path {dir,...}\"");
          ("-v", Arg.Unit (fun () -> OManager.set_verbose true), " Shorthand for \"--verbose\"");
          ("-x", Arg.String add_full_extra_lib, " Shorthand for \"--extra-lib {*.cm*,*.js,...}\"");

          ("-h", Arg.Set print_help, " Shorthand for --help");
          ("-help", Arg.Set print_help, " Like --help");
          ("--help", Arg.Set print_help, " Print this help");
        ]
      in
      let non_release = (* Please preserve the alphabetical order *)
        Qml2jsBackendOptions.Arg.options @
        PassHandler.Arg.options @
        Pass_DbSchemaGeneration.Arg.options @
        Flat_Compiler.Arg.options @
        ObjectFiles.Arg.private_options @
        [
          (* Undocumented options *)
          ("--bytecode", Arg.Unit (fun () -> makefile_rule := Qml2ocamlOptions.Bytecode), " Compile ml in bytecode (default is native)");
          ("--bytecode-or-native", Arg.Unit (fun () -> makefile_rule := Qml2ocamlOptions.Bytecode_or_native), " Compile ml in bytecode or in native");
          ("--bytecode-and-native", Arg.Unit (fun () -> makefile_rule := Qml2ocamlOptions.Bytecode_and_native), " Compile ml in bytecode and in native");

          ("--closure", Arg.Set closure, " Activate opa closures");
          ("--no-closure", Arg.Clear closure, "");

          ("--cps", Arg.Set cps, " Activate cps transformation mode");
          ("--cps-client", Arg.Set cps_client, " Activate cps transformation mode on client");
          ("--cps-toplevel-concurrency", Arg.Tuple [ Arg.Set cps ; Arg.Set cps_toplevel_concurrency ],
           " During cps transformation, toplevel non-functional values are compiled as future (enforce --cps)");
          ("--no-cps", Arg.Clear cps, "");
          ("--show-compilation", Arg.Set show_compilation, " show the caml compilation");
          ("--explicit-instantiation", Arg.Set explicit_instantiation, " Annotate instantiations of polymorphic functions and use the type information at runtime");
          ("--no-explicit-instantiation", Arg.Clear explicit_instantiation, "");
          ("--ei", Arg.Set explicit_instantiation, " A shorthand for --explicit-instantiation");
          ("--no-ei", Arg.Clear explicit_instantiation, "");
          ("--generate-interface",Arg.Set generate_interface," DEPRECATED (use --api-only instead)");
          ("--generate-interface-and-compile",Arg.Set generate_interface_and_compile," DEPRECATED (use --api instead)");

          "--hacker-mode",
          Arg.Set hacker_mode,
          " Perform some useful tricks when compiling the ocaml code for debugging purpose"
          ;

          "--js-back-end",
          Arg.Symbol (available_js_back_end_list, js_back_end),
          Printf.sprintf " Select a JS backend between %s (default is %s)"
            (String.concat ", " available_js_back_end_list) js_back_end_wanted_name
          ;

          ("--js-as", Arg.spec_of_assoc js_serialize ["adhoc", `adhoc; "ast", `ast], " Compile the client into a json string, instead of the runtime ast directly");
          ("--js-no-cleanup", Arg.Clear js_cleanup, "");
          ("--js-no-local-inlining", Arg.Clear js_local_inlining, "");
          ("--js-no-global-inlining", Arg.Clear js_global_inlining, "");
          ("--js-no-local-renaming", Arg.Clear js_local_renaming, "");

          ("--no-cache-parse", Arg.Set no_cache_parse, " UNDOCUMENTED");
          ("--no-discard-of-unused-stdlib", Arg.Set no_discard_of_unused_stdlib, " UNDOCUMENTED");
          ("--no-embedded-stdlib",Arg.Clear embedded_opa, " Disable embedded stdlib usage");
          ("--no-undot", Arg.Unit (fun () -> undot := false), " Deactivate the optimization on module field calls");

          ("--opa-walker", Arg.Unit (fun () -> opa_walker := Some true), " UNDOCUMENTED");
          ("--no-opa-walker", Arg.Unit (fun () -> opa_walker := Some false), " UNDOCUMENTED");
          ("--optimize-rpc", Arg.String set_rpc_options, "(i,p,c) Different level of RPC optimization (i : server values inserted on client code, p : published functions, c : rpc call)");
          ("--profile", Arg.Set profile, " UNDOCUMENTED");
          ("--set-opa-walker", Arg.Symbol (OpaWalker.Options.available_walkers, OpaWalker.Options.set_opa_walker), " UNDOCUMENTED");
          ("--slicer-test", Arg.Set slicer_test, " Make the slicer output specific information (and exit after it)");
          ("--value-restriction", Arg.spec_of_assoc value_restriction ["disabled", `disabled;
                                                                       "normal", `normal;
                                                                       "strict", `strict],
                                              " Restrict definition of polymorphic values")
        ] in
      let speclist =
        Arg.sort (
          Arg.align (
            Arg.add_bash_completion
              ~names:["opa";"opa.exe"]
              ~default:(Arg.File "@(opa|cm@(o|a|x|xa|xs)|js|bypass|opack)")
              (standard @ (if BuildInfos.is_release then [] else non_release))
          )
        ) in

    let anon_fun arg =
        let ext = File.extension arg in
        match ext with
        | "opa" -> add_opa_file arg
        | "cmx" | "cmxa" | "cmo" | "cma" -> add_full_extra_lib arg
        | "cmxs" ->
            let plugin = BslDynlink.SharedObject arg in
            BslDynlink.loadfile_private plugin
        | "opp" -> plugin_inclusion arg
        | "opack" -> !opack_file_function arg
        | "conf" -> ObjectFiles.load_conf arg
        | "opx" -> ObjectFiles.Arg.add_link_package (File.chop_extension arg)
        | _ -> OManager.error "I don't know what to do with anonymous argument %S" arg in

      (** feature : opack files (used e.g. in spec.git) *)
      (** this feature is a macro pass for options, so it requires to be done here not in any pass (too late) *)
      let opack_file_rule file =
        let _ =
          if not (File.is_regular file)
          then OManager.error "cannot find opack file @{<bright>%S@}" file in
        (** beware, in case of any non option arg (a file) we add the prefix before it (the files are pointing from the opack file) *)
        let prefix = Filename.dirname file in
        let env s =
          if not (File.is_relative s) then s else
            File.simplify_path (Filename.concat prefix s)
        in
        let preprocess_word acc word =
          (** assert : called only with at leat 1 char length string without blank *)
          (** solving the env *)
          let find s =
            try Sys.getenv s with Not_found -> s in
          let word =
            try
              let b = Buffer.create 256 in
              let _ = Buffer.add_substitute b find word in
              Buffer.contents b
            with
            | Not_found -> word in

          match word.[0] with
          | '-' -> word :: acc (** this is an option : to be passed 'as is' *)
          | _ ->
              ( if List.mem (File.extension word) [ "opa" ; "conf" ; "opack" ]
                then ( env word )
                else word ) :: acc
                (** this is an opa file : we must prefix it
because in opack file, path to opa files are relative to the opack-file.*)
                (** for js files, we use the extra-path feature *)
        in
        let preprocess acc line =
          let line = String.trim line in
          let len = String.length line in
          if len = 0 then acc
          else
            match line.[0] with
            | '#' -> acc
            | _ ->
                (** split, and call preprocess_word *)
                let split = String.slice_chars " \t\n" in
                List.fold_left preprocess_word acc (split line)
        in
        let opack_options = File.lines_fold preprocess [] file in
        let opack_options = Sys.argv.(0) :: (List.rev opack_options) in
        let opack_options = Array.of_list opack_options in
        try
          Arg.parse_argv ~current:(ref 0) opack_options speclist anon_fun ("")
        with
        | Arg.Bad message ->
            OManager.error "error while reading opack file @{<bright>%S@} :@\n%s@" file message
        | Arg.Help _ ->
            help_menu speclist () ;
            OManager.error "error, the opack file @{<bright>%S@} contains the option --help" file
      in
      (** updating options depending on options *)
      let _ =
        opack_file_function := opack_file_rule ;
        full_help := help_menu speclist
      in
      (** Default opack file *)
      let default_opack = File.concat (Lazy.force File.mlstate_dir) "default.opack" in
      let _ = if File.is_regular default_opack then opack_file_rule default_opack in
      (** Main Command line *)
      Arg.parse speclist anon_fun "";
      (** Print_help **)
      if !print_help then begin
        do_print_help ();
        exit 0
      end;
      (** extra settings at the end *)
      extralibs := MutableList.to_list mutable_extralibs;
      extrajs :=
        (let module B = (val !js_back_end_wanted : Qml2jsOptions.JsBackend) in
         B.runtime_libs ~cps:!cps_client);
      extrapath := MutableList.to_list mutable_extrapath;
      bypass_plugin := MutableList.to_list mutable_bypass_plugin;
      filenames := MutableList.to_list mutable_filenames;
      target := Option.default (!last_target_from_file ^ ".exe") !target_opt;
      target_only_qml := Option.default (!last_target_from_file ^ ".qml") !target_opt;
      target_qmli := Option.default (!last_target_from_file ^ ".qmli") !target_opt;
      target_dbgen_schema := Option.default (!last_target_from_file ^ ".dot") !target_opt

  end

  (* Parse and get options, work with a side effect on module ArgParser *)
  let parse_options () =
    ArgParser.parse ();
    begin
      OpaWalker.Options.disp := match !ArgParser.opa_walker with
      | Some true -> OpaWalker.Options.True
      | Some false -> OpaWalker.Options.ForceExit
      | None ->
          if Unix.isatty (Unix.descr_of_out_channel OpaWalker.Options.och) then
            OpaWalker.Options.True
          else
            OpaWalker.Options.ForceExit
    end


  let check_options opt =
    (* 1) add other check if you need *)
    (*
let _ =
your check
in
*)
    opt

  (* Should not be called somewhere else than in pass_ArgParse *)
  let get_options () = check_options {
    build_dir = !ArgParser.build_dir ;
    run_server_options = Option.map List.rev (!ArgParser.run_server_options) ;
    ocamlc = Lazy.force !ArgParser.Env.ocamlc ;
    ocamlopt = Lazy.force !ArgParser.Env.ocamlopt ;

    cclib = MutableList.to_list ArgParser.cclib ;
    ccopt = MutableList.to_list ArgParser.ccopt ;

    mlcopt = MutableList.to_list ArgParser.mlcopt ;
    mllopt = MutableList.to_list ArgParser.mllopt ;

    back_end = !ArgParser.back_end_wanted ;
    js_back_end = !ArgParser.js_back_end_wanted ;
    hacker_mode = !ArgParser.hacker_mode ;
    makefile_rule = !ArgParser.makefile_rule ;
    filenames = !ArgParser.filenames;
    show_types = !ArgParser.show_types ;

    (* n *)

    no_assert = !ArgParser.no_assert ;
    no_server = !ArgParser.no_server ;

    stdlib = !ArgParser.stdlib ;
    embedded_opa = !ArgParser.embedded_opa ;
    show_compilation = !ArgParser.show_compilation ;
    no_cache_parse = !ArgParser.no_cache_parse ;
    no_discard_of_unused_stdlib = !ArgParser.no_discard_of_unused_stdlib ;
    cps = !ArgParser.cps ;
    cps_client = !ArgParser.cps_client ;
    cps_toplevel_concurrency = !ArgParser.cps_toplevel_concurrency ;
    closure = !ArgParser.closure ;
    extralibs = !ArgParser.extralibs ;
    extrajs = !ArgParser.extrajs ;
    extrapath = !ArgParser.extrapath ;
    resname = File.chop_extension !ArgParser.target ;
    target = !ArgParser.target ;
    explicit_instantiation = !ArgParser.explicit_instantiation ;
    value_restriction = !ArgParser.value_restriction ;

    dump_dbgen_schema = if !ArgParser.dump_dbgen_schema then Some !ArgParser.target_dbgen_schema else None ;
    bypass_plugin = !ArgParser.bypass_plugin ;
    compile_release = !ArgParser.compile_release;
    slicer_test = !ArgParser.slicer_test;
    slicer_dump = !ArgParser.slicer_dump;
    rpc_options = !ArgParser.rpc_options;
    profile = !ArgParser.profile;
    mime_database = !ArgParser.mime_database;
    project_root = !ArgParser.project_root;
    root_inclusions = !ArgParser.root_inclusions;
    undot = !ArgParser.undot;
    js_serialize = !ArgParser.js_serialize;
    generate_interface = !ArgParser.generate_interface;
    generate_interface_and_compile = !ArgParser.generate_interface_and_compile;

    constant_sharing = !ArgParser.constant_sharing;
    constant_sharing_client = !ArgParser.constant_sharing_client;

    js_check_bsl_types = !ArgParser.js_check_bsl_types;
    js_cleanup = !ArgParser.js_cleanup;
    js_local_inlining = !ArgParser.js_local_inlining;
    js_global_inlining = !ArgParser.js_global_inlining;
    js_local_renaming = !ArgParser.js_local_renaming;
    publish_src_code = !ArgParser.publish_src_code;

    i18n = !I18n.r
  }

  let echo_help () = ArgParser.do_print_help ()

  (** Fill a pprocess environment from opa options. *)
  let to_ppenv options env =
    let env =
      let (i, _, _) = options.rpc_options in
      Pprocess.add_env "OPA_OPTIMIZE_RPC_I" (string_of_int i) env
    in let env =
      if options.closure then Pprocess.add_env "OPA_CLOSURE" "" env
      else env
    in let env =
      if options.cps then Pprocess.add_env "OPA_CPS" "" env
      else env
    in let env =
      if options.cps_client then Pprocess.add_env "OPA_CPS_CLIENT" "" env
      else env
    in let env =
      Pprocess.add_env "OPA_BADOP" "1" env
    in let env =
      let module JsCC = (val options.js_back_end : Qml2jsOptions.JsBackend) in
      Pprocess.add_env "OPA_JS_COMPILER" JsCC.name env
    in env
end
Something went wrong with that request. Please try again.