opaEnv.ml

(*
    Copyright © 2011-2013 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

let available_js_bypass_syntax_list = ["classic"; "jsdoc"; "new"]
let js_bypass_syntax_of_string = function
  | "classic" -> Some `classic
  | "jsdoc"
  | "new" -> Some `jsdoc
  | _ -> None
let js_bypass_syntax : [`classic | `jsdoc] ref = ref `jsdoc
let set_js_bypass_syntax s =
  js_bypass_syntax := Option.get (js_bypass_syntax_of_string s)

type opa_back_end = Backend of string

let string_of_available_back_end = function | Backend s -> s

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 : opa_back_end ;
  js_back_end : (module Qml2jsOptions.JsBackend) ;
  hacker_mode : bool ;

  filenames : string list;
  server_plugin_files : string list;
  client_plugin_files : 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 : Qml2jsOptions.extra_lib 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 ;

  parallelism : int; (* maximum number of // compilations *)
  package_version: string; (* The version to be used when outputting
                              the package.json file *)
  js_classic_bypass_syntax: bool;
  backtrace: bool;
}

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

module Options :
sig
  val parse_options : string list list -> (opa_back_end -> opa_back_end) -> 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

  val write_manpage : out_channel -> unit
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 `ast

    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 parallelism = ref 4
    let package_version = ref "0.1.0"
    let set_package_version version =
      package_version := version

    let backtrace = ref false
    let default_back_end = "qmljs"
    let back_end_wanted = ref (Backend default_back_end : opa_back_end)
    let back_end unify_backend_name s =
      let back_end = unify_backend_name (Backend s) in
      back_end_wanted := back_end;
      match back_end with
      | Backend "qmljs" ->
          js_serialize := `ast;
          QmlAstUtils.Const.set_limits `js
      | _ ->
          js_serialize := `adhoc;
          QmlAstUtils.Const.set_limits `ml
    let js_back_end_wanted_name = ref "qmljsimp"
    let js_back_end s = js_back_end_wanted_name := 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 client_plugin_files = MutableList.create ()
    let server_plugin_files = MutableList.create ()

    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.opa_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 synopsis = BuildInfos.opa_command_name ^ " [options] source1.opa [source2.opa ...]"

    let help_menu speclist () =
      let head =
	Printf.sprintf "Usage: %s\nwhere options are :\n" synopsis
      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 speclist available_back_end_list unify_backend_name =
      let standard = (* Please preverse the alphabetical order for lisibility *)
        OManager.Arg.options @
        WarningClass.Arg.options @
        ObjectFiles.Arg.public_options @
        I18n.options @
        OpaSyntax.Args.options @
        BslArgs.options @
        Qml2jsBackendOptions.Arg.options @
        QmlDbGen.Args.options @
        QmlSimpleSlicer.Options.list @
        [
          (* 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"
          ;
	] @ (
	  if List.length available_back_end_list > 1 then [

	    let available_back_end_list = List.flatten available_back_end_list in
            ("--back-end", Arg.Symbol (available_back_end_list, (back_end unify_backend_name)),
             (Printf.sprintf " Select the backend (default is %s)"
		(default_back_end)));
	  ] else []
	) @ [

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

          "--backtrace",
          Arg.Unit (fun () -> backtrace:=true),
          " Enable backtrace " ;

          (* 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");


          ("--conf-opa-files",
           Arg.Unit (fun () -> List.iter add_any_file (ObjectFiles.conf_opa_files ())),
           "Use conf content to determine opa files"
          );


          ("--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");


          ("-j", Arg.Int ((:=)parallelism)," Maximum number of compilation sub-process");
          ("--js-check-bsl-types", Arg.Set js_check_bsl_types, " Enables runtime type checking of the types of bypasses");

          "--js-bypass-syntax",
          Arg.Symbol (available_js_bypass_syntax_list, set_js_bypass_syntax),
          " Choose a bsl directive syntax for JS files (default: \"classic\")" ;

          (* 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. 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.opa_git_version
                        | Some true -> ()
                     ),
          "<version> Ensure that the compiler is newer than the given version"
          ;

          "--maximal-version",
          Arg.String (fun s ->
                        match BuildInfos.assert_maximal_version s with
                        | None ->
                            OManager.error (
                              "option --maximal-version: @{<bright>%s@} not recognized@\n"^^
                              "@[<2>@{<bright>Hint@}:@\n"^^
                              "try e.g. v%%d, or %%d@]"
                            )
                              s
                        | Some false ->
                            OManager.error (
                              "@[<2>This application needs an older version of Opa@\n"^^
                              "Required version: %s or earlier@\n"^^
                              "Current version:  %s/%d@]"
                            )
                              s
                              BuildInfos.opa_version_name
                              BuildInfos.opa_git_version
                        | Some true -> ()
                     ),
          "<version> Ensure that the compiler is older 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");
          ("--package-version", Arg.String set_package_version, " Version to be included in the package.json file (default 0.1.0, qmljs only)");
          ("--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 *)
        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
        Arg.sort (
          Arg.align (
            Arg.add_bash_completion
	      ~name:BuildInfos.opa_command_name
              ~default:(Arg.File "@(opa|cm@(o|a|x|xa|xs)|js|bypass|opack)")
              (standard @ (if BuildInfos.is_release then [] else non_release))
          )
        )

  let parse available_back_end_list unify_backend_name =
    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)
        | "js" -> MutableList.add client_plugin_files arg
        | "nodejs" -> MutableList.add server_plugin_files 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 available_back_end_list unify_backend_name) anon_fun ("")
        with
        | Arg.Bad message ->
            OManager.error "error while reading opack file @{<bright>%S@} :@\n%s@" file message
        | Arg.Help _ ->
            help_menu (speclist available_back_end_list unify_backend_name) () ;
            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 available_back_end_list unify_backend_name)
      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 available_back_end_list unify_backend_name) 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 := [];
      extrapath := MutableList.to_list mutable_extrapath;
      bypass_plugin := MutableList.to_list mutable_bypass_plugin;
      filenames := MutableList.to_list mutable_filenames;
      target := (
        let ext = match !back_end_wanted with
          | Backend "qmljs" -> ".js"
          | _ -> ".exe"
        in
        Option.default (!last_target_from_file ^ ext) !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 available_back_end_list unify_backend_name =
    ArgParser.parse available_back_end_list unify_backend_name;
    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 () =
    let js_back_end =
      available_js_back_end_of_string !ArgParser.js_back_end_wanted_name
    in
    let extrajs =
      (let module B = (val js_back_end : Qml2jsOptions.JsBackend) in
       B.runtime_libs ~cps:!ArgParser.cps_client)
    in
    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;
    hacker_mode = !ArgParser.hacker_mode ;
    makefile_rule = !ArgParser.makefile_rule ;
    filenames = !ArgParser.filenames;
    client_plugin_files = MutableList.to_list ArgParser.client_plugin_files;
    server_plugin_files = MutableList.to_list ArgParser.server_plugin_files;
    show_types = !ArgParser.show_types ;

    (* n *)

    no_assert = !ArgParser.no_assert ;
    no_server =
      (match !ArgParser.no_server with
       | None when OpaSyntax.Args.get_parser None = OpaSyntax.Js -> Some false
       | x -> x)
    ;

    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;
    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;

    parallelism = !ArgParser.parallelism;
    package_version = !ArgParser.package_version;
    js_classic_bypass_syntax = !js_bypass_syntax = `classic;
    backtrace = !ArgParser.backtrace;
  }

  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 let env =
      if options.back_end = Backend "qmljs" then
        let env = Pprocess.add_env "OPA_BACKEND_QMLJS" "1" env in
        let env = Pprocess.add_env "OPA_CHANNEL" "1" env in
        Pprocess.add_env "OPA_FULL_DISPATCHER" "1" env
      else env
    in env

  let write_manpage file =
    Arg.write_simple_manpage
      ~cmdname:BuildInfos.opa_command_name
      ~summary:"The Opa compiler"
      ~section:1
      ~centerheader:"Opa Manual"
      ~synopsis:ArgParser.synopsis
      ~description:"The Opa compiler allows you to compile Opa projects into executable files. Please refer to the online manual on http://doc.opalang.org/manual for a detailed description of the language and its tools.\n"
      ~options:(ArgParser.speclist [["qmljs"]] (fun x -> x))
      ~other:[("VERSION", ArgParser.str_version)]
      file

end