diff --git a/jscomp/bin/compiler.ml b/jscomp/bin/compiler.ml index b3ace34cd7..ff926fa298 100644 --- a/jscomp/bin/compiler.ml +++ b/jscomp/bin/compiler.ml @@ -1,4 +1,4 @@ -(** Bundled by ocaml_pack 05/23-10:06 *) +(** Bundled by ocaml_pack 05/23-17:15 *) module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -4945,6 +4945,7 @@ type env = | AmdJS | Goog of string option +val cmj_ext : string val get_env : unit -> env val get_ext : unit -> string @@ -5033,6 +5034,7 @@ type env = let default_env = ref NodeJS let ext = ref ".js" +let cmj_ext = ".cmj" let get_ext () = !ext let get_env () = !default_env @@ -13242,7 +13244,7 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = let oid = Lam_module_ident.of_ml id in begin match Hashtbl.find cached_tbl oid with | exception Not_found -> - let cmj_table = Config_util.find_cmj (id.name ^ ".cmj") in + let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in begin match Type_util.find_serializable_signatures_by_path (Pident id) env with @@ -13298,7 +13300,7 @@ let query_and_add_if_not_exist (type u) begin match oid.kind with | Runtime -> let cmj_table = - Config_util.find_cmj (Lam_module_ident.name oid ^ ".cmj") in + Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in add_cached_tbl oid (Runtime (true,cmj_table)) ; begin match env with | Has_env _ -> @@ -13309,7 +13311,7 @@ let query_and_add_if_not_exist (type u) | Ml -> let cmj_table = - Config_util.find_cmj (Lam_module_ident.name oid ^ ".cmj") in + Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in begin match env with | Has_env env -> begin match @@ -20461,7 +20463,7 @@ and all_lambdas meta (xs : Lambda.lambda list) = let dump_exports_arities (meta : Lam_stats.meta ) = let fmt = if meta.filename != "" then - let cmj_file = Ext_filename.chop_extension meta.filename ^ ".cmj" in + let cmj_file = Ext_filename.chop_extension meta.filename ^ Js_config.cmj_ext in let out = open_out cmj_file in Format.formatter_of_out_channel out else @@ -24672,6 +24674,7 @@ module Lam_compile_group : sig *) val compile : filename : string -> + string -> bool -> Env.t -> Types.signature -> @@ -24680,7 +24683,8 @@ val compile : val lambda_as_module : Env.t -> - Types.signature -> string -> Lambda.lambda -> unit + Types.signature -> string -> + string -> Lambda.lambda -> unit end = struct #1 "lam_compile_group.ml" @@ -24863,7 +24867,7 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta) it's used or not [non_export] is only used in playground *) -let compile ~filename non_export env _sigs lam = +let compile ~filename output_prefix non_export env _sigs lam = let export_idents = if non_export then [] @@ -25087,7 +25091,7 @@ let compile ~filename non_export env _sigs lam = in (if not @@ Ext_string.is_empty filename then Js_cmj_format.to_file - (Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".cmj") v); + (output_prefix ^ Js_config.cmj_ext) v); Js_program_loader.decorate_deps required_modules v.effect js ) | _ -> raise Not_a_module @@ -25101,6 +25105,7 @@ let lambda_as_module env (sigs : Types.signature) (filename : string) + (output_prefix : string) (lam : Lambda.lambda) = begin Lam_current_unit.set_file filename ; @@ -25108,7 +25113,7 @@ let lambda_as_module Ext_pervasives.with_file_as_chan (Js_config.get_output_file filename) (fun chan -> Js_dump.dump_deps_program - (compile ~filename false env sigs lam) chan) + (compile ~filename output_prefix false env sigs lam) chan) end (* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, We need handle some definitions in standard libraries in a special way, most are io specific, @@ -26330,7 +26335,7 @@ let implementation ppf sourcefile outputprefix = match Lam_compile_group.lambda_as_module finalenv current_signature - sourcefile lambda with + sourcefile outputprefix lambda with | e -> e | exception e -> (* Save to a file instead so that it will not scare user *) @@ -26398,19 +26403,17 @@ let process_interface_file ppf name = let process_implementation_file ppf name = let opref = output_prefix name in - Js_implementation.implementation ppf name opref; - objfiles := (opref ^ ".cmo") :: !objfiles + Js_implementation.implementation ppf name opref + let process_file ppf name = if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mlt" then begin let opref = output_prefix name in - Js_implementation.implementation ppf name opref; - objfiles := (opref ^ ".cmo") :: !objfiles + Js_implementation.implementation ppf name opref end else if Filename.check_suffix name !Config.interface_suffix then begin let opref = output_prefix name in - Js_implementation.interface ppf name opref; - if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles + Js_implementation.interface ppf name opref end else raise(Arg.Bad("don't know what to do with " ^ name)) @@ -26432,80 +26435,228 @@ let show_config () = exit 0; ;; -module Options = Main_args.Make_bytecomp_options (struct - let set r () = r := true - let unset r () = r := false - let _a = set make_archive - let _absname = set Location.absname - let _annot = set annotations - let _binannot = set binary_annotations - let _c = set compile_only - let _cc s = c_compiler := Some s - let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs - let _ccopt s = first_ccopts := s :: !first_ccopts - let _compat_32 = set bytecode_compatible_32 - let _config = show_config - let _custom = set custom_runtime - let _no_check_prims = set no_check_prims - let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs - let _dllpath s = dllpaths := !dllpaths @ [s] - let _for_pack s = for_package := Some s - let _g = set debug - let _i () = print_types := true; compile_only := true - let _I s = include_dirs := s :: !include_dirs - let _impl = impl - let _intf = intf - let _intf_suffix s = Config.interface_suffix := s - let _keep_docs = set keep_docs - let _keep_locs = set keep_locs - let _labels = unset classic - let _linkall = set link_everything - let _make_runtime () = - custom_runtime := true; make_runtime := true; link_everything := true - let _no_alias_deps = set transparent_modules - let _no_app_funct = unset applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noautolink = set no_auto_link - let _nostdlib = set no_std_include - let _o s = output_name := Some s - let _open s = open_modules := s :: !open_modules - let _output_obj () = output_c_object := true; custom_runtime := true - let _output_complete_obj () = - output_c_object := true; output_complete_object := true; custom_runtime := true - let _pack = set make_package - let _pp s = preprocessor := Some s - let _ppx s = first_ppx := s :: !first_ppx - let _principal = set principal - let _rectypes = set recursive_types - let _runtime_variant s = runtime_variant := s - let _safe_string = unset unsafe_string - let _short_paths = unset real_paths - let _strict_sequence = set strict_sequence - let _strict_formats = set strict_formats - let _thread = set use_threads - let _vmthread = set use_vmthreads - let _unsafe = set fast - let _unsafe_string = set unsafe_string - let _use_prims s = use_prims := s - let _use_runtime s = use_runtime := s - let _v () = print_version_and_library "compiler" - let _version = print_version_string - let _vnum = print_version_string - let _w = (Warnings.parse_options false) - let _warn_error = (Warnings.parse_options true) - let _warn_help = Warnings.help_warnings - let _where = print_standard_library - let _verbose = set verbose - let _nopervasives = set nopervasives - let _dsource = set dump_source - let _dparsetree = set dump_parsetree - let _dtypedtree = set dump_typedtree - let _drawlambda = set dump_rawlambda - let _dlambda = set dump_lambda - let _dinstr = set dump_instr - let anonymous = anonymous -end) +let mk_absname f = + "-absname", Arg.Unit f, " Show absolute filenames in error messages" +;; + +let mk_annot f = + "-annot", Arg.Unit f, " Save information in .annot" +;; + +let mk_binannot f = + "-bin-annot", Arg.Unit f, " Save typedtree in .cmt" +;; + +let mk_c f = + "-c", Arg.Unit f, " Compile only (do not link)" +;; + +let mk_config f = + "-config", Arg.Unit f, " Print configuration values and exit" +;; + +let mk_g_byt f = + "-g", Arg.Unit f, " Save debugging information" +;; + +let mk_i f = + "-i", Arg.Unit f, " Print inferred interface" +;; + +let mk_I f = + "-I", Arg.String f, " Add to the list of include directories" +;; + +let mk_impl f = + "-impl", Arg.String f, " Compile as a .ml file" +;; + +let mk_intf f = + "-intf", Arg.String f, " Compile as a .mli file" +;; + +let mk_intf_suffix f = + "-intf-suffix", Arg.String f, + " Suffix for interface files (default: .mli)" +;; + +let mk_keep_docs f = + "-keep-docs", Arg.Unit f, " Keep documentation strings in .cmi files" +;; + +let mk_keep_locs f = + "-keep-locs", Arg.Unit f, " Keep locations in .cmi files" +;; + +let mk_labels f = + "-labels", Arg.Unit f, " Use commuting label mode" +;; + +let mk_no_alias_deps f = + "-no-alias-deps", Arg.Unit f, + " Do not record dependencies for module aliases" +;; + +let mk_no_app_funct f = + "-no-app-funct", Arg.Unit f, " Deactivate applicative functors" +;; + +let mk_no_check_prims f = + "-no-check-prims", Arg.Unit f, " Do not check runtime for primitives" +;; + +let mk_noassert f = + "-noassert", Arg.Unit f, " Do not compile assertion checks" +;; + +let mk_nolabels f = + "-nolabels", Arg.Unit f, " Ignore non-optional labels in types" +;; + +let mk_nostdlib f = + "-nostdlib", Arg.Unit f, + " Do not add default directory to the list of include directories" +;; + +let mk_o f = + "-o", Arg.String f, " Set output file name to " +;; + +let mk_open f = + "-open", Arg.String f, " Opens the module before typing" + +let mk_pp f = + "-pp", Arg.String f, " Pipe sources through preprocessor " +;; + +let mk_ppx f = + "-ppx", Arg.String f, + " Pipe abstract syntax trees through preprocessor " +;; + +let mk_principal f = + "-principal", Arg.Unit f, " Check principality of type inference" +;; + +let mk_rectypes f = + "-rectypes", Arg.Unit f, " Allow arbitrary recursive types" +;; + +let mk_safe_string f = + "-safe-string", Arg.Unit f, " Make strings immutable" +;; + +let mk_short_paths f = + "-short-paths", Arg.Unit f, " Shorten paths in types" +;; + +let mk_stdin f = + "-stdin", Arg.Unit f, " Read script from standard input" +;; + +let mk_strict_sequence f = + "-strict-sequence", Arg.Unit f, + " Left-hand part of a sequence must have type unit" +;; + +let mk_unsafe f = + "-unsafe", Arg.Unit f, + " Do not compile bounds checking on array and string access" +;; + +let mk_v f = + "-v", Arg.Unit f, + " Print compiler version and location of standard library and exit" +;; + +let mk_verbose f = + "-verbose", Arg.Unit f, " Print calls to external commands" +;; + +let mk_version f = + "-version", Arg.Unit f, " Print version and exit" +;; + +let mk_vnum f = + "-vnum", Arg.Unit f, " Print version number and exit" +;; + +let mk_w f = + "-w", Arg.String f, + Printf.sprintf + " Enable or disable warnings according to :\n\ + \ + enable warnings in \n\ + \ - disable warnings in \n\ + \ @ enable warnings in and treat them as errors\n\ + \ can be:\n\ + \ a single warning number\n\ + \ .. a range of consecutive warning numbers\n\ + \ a predefined set\n\ + \ default setting is %S" Warnings.defaults_w +;; + +let mk_warn_error f = + "-warn-error", Arg.String f, + Printf.sprintf + " Enable or disable error status for warnings according\n\ + \ to . See option -w for the syntax of .\n\ + \ Default setting is %S" Warnings.defaults_warn_error +;; + +let mk_warn_help f = + "-warn-help", Arg.Unit f, " Show description of warning numbers" +;; + +let mk_where f = + "-where", Arg.Unit f, " Print location of standard library and exit" +;; + +let mk_nopervasives f = + "-nopervasives", Arg.Unit f, " (undocumented)" +;; + +let mk_dparsetree f = + "-dparsetree", Arg.Unit f, " (undocumented)" +;; + +let mk_dtypedtree f = + "-dtypedtree", Arg.Unit f, " (undocumented)" +;; + +let mk_drawlambda f = + "-drawlambda", Arg.Unit f, " (undocumented)" +;; + +let mk_dsource f = + "-dsource", Arg.Unit f, " (undocumented)" +;; + +let mk_dlambda f = + "-dlambda", Arg.Unit f, " (undocumented)" +;; + +let mk_opaque f = + "-opaque", Arg.Unit f, + " Does not generate cross-module optimization information\n\ + \ (reduces necessary recompilation on module change)" +;; + +let mk_strict_formats f = + "-strict-formats", Arg.Unit f, + " Reject invalid formats accepted by legacy implementations\n\ + \ (Warning: Invalid formats may behave differently from\n\ + \ previous OCaml versions, and will become always-rejected\n\ + \ in future OCaml versions. You should use this flag\n\ + \ to detect and fix invalid formats.)" +;; + +let mk__ f = + "-", Arg.String f, + " Treat as a file name (even if it starts with `-')" +;; + + + let add_include_path s = let (//) = Filename.concat in @@ -26532,7 +26683,127 @@ let buckle_script_flags = "disable built-in ppx for mli files (internal use)") :: ("-js-gen-tds", Arg.Set Js_config.default_gen_tds, " set will generate `.d.ts` file for typescript (experimental)") - :: Options.list + :: ( + let module F = struct + let set r () = r := true + let unset r () = r := false + let _a = set make_archive + let _absname = set Location.absname + let _annot = set annotations + let _binannot = set binary_annotations + let _c = set compile_only + let _cc s = c_compiler := Some s + let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs + let _ccopt s = first_ccopts := s :: !first_ccopts + let _compat_32 = set bytecode_compatible_32 + let _config = show_config + let _custom = set custom_runtime + let _no_check_prims = set no_check_prims + let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs + let _dllpath s = dllpaths := !dllpaths @ [s] + let _for_pack s = for_package := Some s + let _g = set debug + let _i () = print_types := true; compile_only := true + let _I s = include_dirs := s :: !include_dirs + let _impl = impl + let _intf = intf + let _intf_suffix s = Config.interface_suffix := s + let _keep_docs = set keep_docs + let _keep_locs = set keep_locs + let _labels = unset classic + let _linkall = set link_everything + let _make_runtime () = + custom_runtime := true; make_runtime := true; link_everything := true + let _no_alias_deps = set transparent_modules + let _no_app_funct = unset applicative_functors + let _noassert = set noassert + let _nolabels = set classic + let _noautolink = set no_auto_link + let _nostdlib = set no_std_include + let _o s = output_name := Some s + let _open s = open_modules := s :: !open_modules + let _output_obj () = output_c_object := true; custom_runtime := true + let _output_complete_obj () = + output_c_object := true; output_complete_object := true; custom_runtime := true + let _pack = set make_package + let _pp s = preprocessor := Some s + let _ppx s = first_ppx := s :: !first_ppx + let _principal = set principal + let _rectypes = set recursive_types + let _runtime_variant s = runtime_variant := s + let _safe_string = unset unsafe_string + let _short_paths = unset real_paths + let _strict_sequence = set strict_sequence + let _strict_formats = set strict_formats + let _thread = set use_threads + let _vmthread = set use_vmthreads + let _unsafe = set fast + let _unsafe_string = set unsafe_string + let _use_prims s = use_prims := s + let _use_runtime s = use_runtime := s + let _v () = print_version_and_library "compiler" + let _version = print_version_string + let _vnum = print_version_string + let _w = (Warnings.parse_options false) + let _warn_error = (Warnings.parse_options true) + let _warn_help = Warnings.help_warnings + let _where = print_standard_library + let _verbose = set verbose + let _nopervasives = set nopervasives + let _dsource = set dump_source + let _dparsetree = set dump_parsetree + let _dtypedtree = set dump_typedtree + let _drawlambda = set dump_rawlambda + let _dlambda = set dump_lambda + let _dinstr = set dump_instr + let anonymous = anonymous + end in + [ mk_absname F._absname; + mk_annot F._annot; + mk_binannot F._binannot; + mk_c F._c; + mk_config F._config; + mk_g_byt F._g; + mk_i F._i; + mk_I F._I; + mk_impl F._impl; + mk_intf F._intf; + mk_intf_suffix F._intf_suffix; + mk_keep_docs F._keep_docs; + mk_keep_locs F._keep_locs; + mk_labels F._labels; + mk_no_alias_deps F._no_alias_deps; + mk_no_app_funct F._no_app_funct; + mk_noassert F._noassert; + mk_nolabels F._nolabels; + mk_nostdlib F._nostdlib; + mk_o F._o; + mk_open F._open; + mk_pp F._pp; + mk_ppx F._ppx; + mk_principal F._principal; + mk_rectypes F._rectypes; + mk_safe_string F._safe_string; + mk_short_paths F._short_paths; + mk_strict_sequence F._strict_sequence; + mk_strict_formats F._strict_formats; + mk_unsafe F._unsafe; + mk_v F._v; + mk_verbose F._verbose; + mk_version F._version; + mk_vnum F._vnum; + mk_w F._w; + mk_warn_error F._warn_error; + mk_warn_help F._warn_help; + mk_where F._where; + mk__ F.anonymous; + mk_nopervasives F._nopervasives; + mk_dsource F._dsource; + mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; + mk_drawlambda F._drawlambda; + mk_dlambda F._dlambda ] + ) let () = Clflags.unsafe_string := false; diff --git a/jscomp/js_config.ml b/jscomp/js_config.ml index e2a2e733a3..3992ac3198 100644 --- a/jscomp/js_config.ml +++ b/jscomp/js_config.ml @@ -37,6 +37,7 @@ type env = let default_env = ref NodeJS let ext = ref ".js" +let cmj_ext = ".cmj" let get_ext () = !ext let get_env () = !default_env diff --git a/jscomp/js_config.mli b/jscomp/js_config.mli index 5b12e4a60b..a2ba456aa2 100644 --- a/jscomp/js_config.mli +++ b/jscomp/js_config.mli @@ -33,6 +33,7 @@ type env = | AmdJS | Goog of string option +val cmj_ext : string val get_env : unit -> env val get_ext : unit -> string diff --git a/jscomp/js_implementation.ml b/jscomp/js_implementation.ml index 208401998d..989501cbda 100644 --- a/jscomp/js_implementation.ml +++ b/jscomp/js_implementation.ml @@ -76,7 +76,7 @@ let implementation ppf sourcefile outputprefix = match Lam_compile_group.lambda_as_module finalenv current_signature - sourcefile lambda with + sourcefile outputprefix lambda with | e -> e | exception e -> (* Save to a file instead so that it will not scare user *) diff --git a/jscomp/js_main.ml b/jscomp/js_main.ml index 47f1998cae..cda174c75f 100644 --- a/jscomp/js_main.ml +++ b/jscomp/js_main.ml @@ -44,19 +44,17 @@ let process_interface_file ppf name = let process_implementation_file ppf name = let opref = output_prefix name in - Js_implementation.implementation ppf name opref; - objfiles := (opref ^ ".cmo") :: !objfiles + Js_implementation.implementation ppf name opref + let process_file ppf name = if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mlt" then begin let opref = output_prefix name in - Js_implementation.implementation ppf name opref; - objfiles := (opref ^ ".cmo") :: !objfiles + Js_implementation.implementation ppf name opref end else if Filename.check_suffix name !Config.interface_suffix then begin let opref = output_prefix name in - Js_implementation.interface ppf name opref; - if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles + Js_implementation.interface ppf name opref end else raise(Arg.Bad("don't know what to do with " ^ name)) @@ -78,80 +76,228 @@ let show_config () = exit 0; ;; -module Options = Main_args.Make_bytecomp_options (struct - let set r () = r := true - let unset r () = r := false - let _a = set make_archive - let _absname = set Location.absname - let _annot = set annotations - let _binannot = set binary_annotations - let _c = set compile_only - let _cc s = c_compiler := Some s - let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs - let _ccopt s = first_ccopts := s :: !first_ccopts - let _compat_32 = set bytecode_compatible_32 - let _config = show_config - let _custom = set custom_runtime - let _no_check_prims = set no_check_prims - let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs - let _dllpath s = dllpaths := !dllpaths @ [s] - let _for_pack s = for_package := Some s - let _g = set debug - let _i () = print_types := true; compile_only := true - let _I s = include_dirs := s :: !include_dirs - let _impl = impl - let _intf = intf - let _intf_suffix s = Config.interface_suffix := s - let _keep_docs = set keep_docs - let _keep_locs = set keep_locs - let _labels = unset classic - let _linkall = set link_everything - let _make_runtime () = - custom_runtime := true; make_runtime := true; link_everything := true - let _no_alias_deps = set transparent_modules - let _no_app_funct = unset applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noautolink = set no_auto_link - let _nostdlib = set no_std_include - let _o s = output_name := Some s - let _open s = open_modules := s :: !open_modules - let _output_obj () = output_c_object := true; custom_runtime := true - let _output_complete_obj () = - output_c_object := true; output_complete_object := true; custom_runtime := true - let _pack = set make_package - let _pp s = preprocessor := Some s - let _ppx s = first_ppx := s :: !first_ppx - let _principal = set principal - let _rectypes = set recursive_types - let _runtime_variant s = runtime_variant := s - let _safe_string = unset unsafe_string - let _short_paths = unset real_paths - let _strict_sequence = set strict_sequence - let _strict_formats = set strict_formats - let _thread = set use_threads - let _vmthread = set use_vmthreads - let _unsafe = set fast - let _unsafe_string = set unsafe_string - let _use_prims s = use_prims := s - let _use_runtime s = use_runtime := s - let _v () = print_version_and_library "compiler" - let _version = print_version_string - let _vnum = print_version_string - let _w = (Warnings.parse_options false) - let _warn_error = (Warnings.parse_options true) - let _warn_help = Warnings.help_warnings - let _where = print_standard_library - let _verbose = set verbose - let _nopervasives = set nopervasives - let _dsource = set dump_source - let _dparsetree = set dump_parsetree - let _dtypedtree = set dump_typedtree - let _drawlambda = set dump_rawlambda - let _dlambda = set dump_lambda - let _dinstr = set dump_instr - let anonymous = anonymous -end) +let mk_absname f = + "-absname", Arg.Unit f, " Show absolute filenames in error messages" +;; + +let mk_annot f = + "-annot", Arg.Unit f, " Save information in .annot" +;; + +let mk_binannot f = + "-bin-annot", Arg.Unit f, " Save typedtree in .cmt" +;; + +let mk_c f = + "-c", Arg.Unit f, " Compile only (do not link)" +;; + +let mk_config f = + "-config", Arg.Unit f, " Print configuration values and exit" +;; + +let mk_g_byt f = + "-g", Arg.Unit f, " Save debugging information" +;; + +let mk_i f = + "-i", Arg.Unit f, " Print inferred interface" +;; + +let mk_I f = + "-I", Arg.String f, " Add to the list of include directories" +;; + +let mk_impl f = + "-impl", Arg.String f, " Compile as a .ml file" +;; + +let mk_intf f = + "-intf", Arg.String f, " Compile as a .mli file" +;; + +let mk_intf_suffix f = + "-intf-suffix", Arg.String f, + " Suffix for interface files (default: .mli)" +;; + +let mk_keep_docs f = + "-keep-docs", Arg.Unit f, " Keep documentation strings in .cmi files" +;; + +let mk_keep_locs f = + "-keep-locs", Arg.Unit f, " Keep locations in .cmi files" +;; + +let mk_labels f = + "-labels", Arg.Unit f, " Use commuting label mode" +;; + +let mk_no_alias_deps f = + "-no-alias-deps", Arg.Unit f, + " Do not record dependencies for module aliases" +;; + +let mk_no_app_funct f = + "-no-app-funct", Arg.Unit f, " Deactivate applicative functors" +;; + +let mk_no_check_prims f = + "-no-check-prims", Arg.Unit f, " Do not check runtime for primitives" +;; + +let mk_noassert f = + "-noassert", Arg.Unit f, " Do not compile assertion checks" +;; + +let mk_nolabels f = + "-nolabels", Arg.Unit f, " Ignore non-optional labels in types" +;; + +let mk_nostdlib f = + "-nostdlib", Arg.Unit f, + " Do not add default directory to the list of include directories" +;; + +let mk_o f = + "-o", Arg.String f, " Set output file name to " +;; + +let mk_open f = + "-open", Arg.String f, " Opens the module before typing" + +let mk_pp f = + "-pp", Arg.String f, " Pipe sources through preprocessor " +;; + +let mk_ppx f = + "-ppx", Arg.String f, + " Pipe abstract syntax trees through preprocessor " +;; + +let mk_principal f = + "-principal", Arg.Unit f, " Check principality of type inference" +;; + +let mk_rectypes f = + "-rectypes", Arg.Unit f, " Allow arbitrary recursive types" +;; + +let mk_safe_string f = + "-safe-string", Arg.Unit f, " Make strings immutable" +;; + +let mk_short_paths f = + "-short-paths", Arg.Unit f, " Shorten paths in types" +;; + +let mk_stdin f = + "-stdin", Arg.Unit f, " Read script from standard input" +;; + +let mk_strict_sequence f = + "-strict-sequence", Arg.Unit f, + " Left-hand part of a sequence must have type unit" +;; + +let mk_unsafe f = + "-unsafe", Arg.Unit f, + " Do not compile bounds checking on array and string access" +;; + +let mk_v f = + "-v", Arg.Unit f, + " Print compiler version and location of standard library and exit" +;; + +let mk_verbose f = + "-verbose", Arg.Unit f, " Print calls to external commands" +;; + +let mk_version f = + "-version", Arg.Unit f, " Print version and exit" +;; + +let mk_vnum f = + "-vnum", Arg.Unit f, " Print version number and exit" +;; + +let mk_w f = + "-w", Arg.String f, + Printf.sprintf + " Enable or disable warnings according to :\n\ + \ + enable warnings in \n\ + \ - disable warnings in \n\ + \ @ enable warnings in and treat them as errors\n\ + \ can be:\n\ + \ a single warning number\n\ + \ .. a range of consecutive warning numbers\n\ + \ a predefined set\n\ + \ default setting is %S" Warnings.defaults_w +;; + +let mk_warn_error f = + "-warn-error", Arg.String f, + Printf.sprintf + " Enable or disable error status for warnings according\n\ + \ to . See option -w for the syntax of .\n\ + \ Default setting is %S" Warnings.defaults_warn_error +;; + +let mk_warn_help f = + "-warn-help", Arg.Unit f, " Show description of warning numbers" +;; + +let mk_where f = + "-where", Arg.Unit f, " Print location of standard library and exit" +;; + +let mk_nopervasives f = + "-nopervasives", Arg.Unit f, " (undocumented)" +;; + +let mk_dparsetree f = + "-dparsetree", Arg.Unit f, " (undocumented)" +;; + +let mk_dtypedtree f = + "-dtypedtree", Arg.Unit f, " (undocumented)" +;; + +let mk_drawlambda f = + "-drawlambda", Arg.Unit f, " (undocumented)" +;; + +let mk_dsource f = + "-dsource", Arg.Unit f, " (undocumented)" +;; + +let mk_dlambda f = + "-dlambda", Arg.Unit f, " (undocumented)" +;; + +let mk_opaque f = + "-opaque", Arg.Unit f, + " Does not generate cross-module optimization information\n\ + \ (reduces necessary recompilation on module change)" +;; + +let mk_strict_formats f = + "-strict-formats", Arg.Unit f, + " Reject invalid formats accepted by legacy implementations\n\ + \ (Warning: Invalid formats may behave differently from\n\ + \ previous OCaml versions, and will become always-rejected\n\ + \ in future OCaml versions. You should use this flag\n\ + \ to detect and fix invalid formats.)" +;; + +let mk__ f = + "-", Arg.String f, + " Treat as a file name (even if it starts with `-')" +;; + + + let add_include_path s = let (//) = Filename.concat in @@ -178,7 +324,127 @@ let buckle_script_flags = "disable built-in ppx for mli files (internal use)") :: ("-js-gen-tds", Arg.Set Js_config.default_gen_tds, " set will generate `.d.ts` file for typescript (experimental)") - :: Options.list + :: ( + let module F = struct + let set r () = r := true + let unset r () = r := false + let _a = set make_archive + let _absname = set Location.absname + let _annot = set annotations + let _binannot = set binary_annotations + let _c = set compile_only + let _cc s = c_compiler := Some s + let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs + let _ccopt s = first_ccopts := s :: !first_ccopts + let _compat_32 = set bytecode_compatible_32 + let _config = show_config + let _custom = set custom_runtime + let _no_check_prims = set no_check_prims + let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs + let _dllpath s = dllpaths := !dllpaths @ [s] + let _for_pack s = for_package := Some s + let _g = set debug + let _i () = print_types := true; compile_only := true + let _I s = include_dirs := s :: !include_dirs + let _impl = impl + let _intf = intf + let _intf_suffix s = Config.interface_suffix := s + let _keep_docs = set keep_docs + let _keep_locs = set keep_locs + let _labels = unset classic + let _linkall = set link_everything + let _make_runtime () = + custom_runtime := true; make_runtime := true; link_everything := true + let _no_alias_deps = set transparent_modules + let _no_app_funct = unset applicative_functors + let _noassert = set noassert + let _nolabels = set classic + let _noautolink = set no_auto_link + let _nostdlib = set no_std_include + let _o s = output_name := Some s + let _open s = open_modules := s :: !open_modules + let _output_obj () = output_c_object := true; custom_runtime := true + let _output_complete_obj () = + output_c_object := true; output_complete_object := true; custom_runtime := true + let _pack = set make_package + let _pp s = preprocessor := Some s + let _ppx s = first_ppx := s :: !first_ppx + let _principal = set principal + let _rectypes = set recursive_types + let _runtime_variant s = runtime_variant := s + let _safe_string = unset unsafe_string + let _short_paths = unset real_paths + let _strict_sequence = set strict_sequence + let _strict_formats = set strict_formats + let _thread = set use_threads + let _vmthread = set use_vmthreads + let _unsafe = set fast + let _unsafe_string = set unsafe_string + let _use_prims s = use_prims := s + let _use_runtime s = use_runtime := s + let _v () = print_version_and_library "compiler" + let _version = print_version_string + let _vnum = print_version_string + let _w = (Warnings.parse_options false) + let _warn_error = (Warnings.parse_options true) + let _warn_help = Warnings.help_warnings + let _where = print_standard_library + let _verbose = set verbose + let _nopervasives = set nopervasives + let _dsource = set dump_source + let _dparsetree = set dump_parsetree + let _dtypedtree = set dump_typedtree + let _drawlambda = set dump_rawlambda + let _dlambda = set dump_lambda + let _dinstr = set dump_instr + let anonymous = anonymous + end in + [ mk_absname F._absname; + mk_annot F._annot; + mk_binannot F._binannot; + mk_c F._c; + mk_config F._config; + mk_g_byt F._g; + mk_i F._i; + mk_I F._I; + mk_impl F._impl; + mk_intf F._intf; + mk_intf_suffix F._intf_suffix; + mk_keep_docs F._keep_docs; + mk_keep_locs F._keep_locs; + mk_labels F._labels; + mk_no_alias_deps F._no_alias_deps; + mk_no_app_funct F._no_app_funct; + mk_noassert F._noassert; + mk_nolabels F._nolabels; + mk_nostdlib F._nostdlib; + mk_o F._o; + mk_open F._open; + mk_pp F._pp; + mk_ppx F._ppx; + mk_principal F._principal; + mk_rectypes F._rectypes; + mk_safe_string F._safe_string; + mk_short_paths F._short_paths; + mk_strict_sequence F._strict_sequence; + mk_strict_formats F._strict_formats; + mk_unsafe F._unsafe; + mk_v F._v; + mk_verbose F._verbose; + mk_version F._version; + mk_vnum F._vnum; + mk_w F._w; + mk_warn_error F._warn_error; + mk_warn_help F._warn_help; + mk_where F._where; + mk__ F.anonymous; + mk_nopervasives F._nopervasives; + mk_dsource F._dsource; + mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; + mk_drawlambda F._drawlambda; + mk_dlambda F._dlambda ] + ) let () = Clflags.unsafe_string := false; diff --git a/jscomp/js_pack.ml b/jscomp/js_pack.ml index 3d4a6bcbfe..52b09144b8 100644 --- a/jscomp/js_pack.ml +++ b/jscomp/js_pack.ml @@ -31,7 +31,7 @@ let get_files dir = let arr = Sys.readdir dir |> Ext_array.filter_map - (fun x -> if Ext_string.ends_with x ".cmj" then Some (Filename.concat dir x) else None ) + (fun x -> if Ext_string.ends_with x Js_config.cmj_ext then Some (Filename.concat dir x) else None ) in (* Sort to guarantee it works the same across OSes *) Array.sort (fun (x : string) y -> Pervasives.compare x y ) arr; diff --git a/jscomp/lam_compile_env.ml b/jscomp/lam_compile_env.ml index 6644d3426b..2fecd4d2b5 100644 --- a/jscomp/lam_compile_env.ml +++ b/jscomp/lam_compile_env.ml @@ -99,7 +99,7 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = let oid = Lam_module_ident.of_ml id in begin match Hashtbl.find cached_tbl oid with | exception Not_found -> - let cmj_table = Config_util.find_cmj (id.name ^ ".cmj") in + let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in begin match Type_util.find_serializable_signatures_by_path (Pident id) env with @@ -155,7 +155,7 @@ let query_and_add_if_not_exist (type u) begin match oid.kind with | Runtime -> let cmj_table = - Config_util.find_cmj (Lam_module_ident.name oid ^ ".cmj") in + Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in add_cached_tbl oid (Runtime (true,cmj_table)) ; begin match env with | Has_env _ -> @@ -166,7 +166,7 @@ let query_and_add_if_not_exist (type u) | Ml -> let cmj_table = - Config_util.find_cmj (Lam_module_ident.name oid ^ ".cmj") in + Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in begin match env with | Has_env env -> begin match diff --git a/jscomp/lam_compile_group.ml b/jscomp/lam_compile_group.ml index 3bf0be426d..a52835dfd9 100644 --- a/jscomp/lam_compile_group.ml +++ b/jscomp/lam_compile_group.ml @@ -177,7 +177,7 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta) it's used or not [non_export] is only used in playground *) -let compile ~filename non_export env _sigs lam = +let compile ~filename output_prefix non_export env _sigs lam = let export_idents = if non_export then [] @@ -401,7 +401,7 @@ let compile ~filename non_export env _sigs lam = in (if not @@ Ext_string.is_empty filename then Js_cmj_format.to_file - (Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".cmj") v); + (output_prefix ^ Js_config.cmj_ext) v); Js_program_loader.decorate_deps required_modules v.effect js ) | _ -> raise Not_a_module @@ -415,6 +415,7 @@ let lambda_as_module env (sigs : Types.signature) (filename : string) + (output_prefix : string) (lam : Lambda.lambda) = begin Lam_current_unit.set_file filename ; @@ -422,7 +423,7 @@ let lambda_as_module Ext_pervasives.with_file_as_chan (Js_config.get_output_file filename) (fun chan -> Js_dump.dump_deps_program - (compile ~filename false env sigs lam) chan) + (compile ~filename output_prefix false env sigs lam) chan) end (* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, We need handle some definitions in standard libraries in a special way, most are io specific, diff --git a/jscomp/lam_compile_group.mli b/jscomp/lam_compile_group.mli index 8e0abfc3a2..9800d8c1fb 100644 --- a/jscomp/lam_compile_group.mli +++ b/jscomp/lam_compile_group.mli @@ -39,6 +39,7 @@ *) val compile : filename : string -> + string -> bool -> Env.t -> Types.signature -> @@ -47,4 +48,5 @@ val compile : val lambda_as_module : Env.t -> - Types.signature -> string -> Lambda.lambda -> unit + Types.signature -> string -> + string -> Lambda.lambda -> unit diff --git a/jscomp/lam_stats_util.ml b/jscomp/lam_stats_util.ml index 386226aa6f..cae8562ea9 100644 --- a/jscomp/lam_stats_util.ml +++ b/jscomp/lam_stats_util.ml @@ -215,7 +215,7 @@ and all_lambdas meta (xs : Lambda.lambda list) = let dump_exports_arities (meta : Lam_stats.meta ) = let fmt = if meta.filename != "" then - let cmj_file = Ext_filename.chop_extension meta.filename ^ ".cmj" in + let cmj_file = Ext_filename.chop_extension meta.filename ^ Js_config.cmj_ext in let out = open_out cmj_file in Format.formatter_of_out_channel out else diff --git a/package.json b/package.json index 6fc638ed5d..73b3288113 100644 --- a/package.json +++ b/package.json @@ -23,7 +23,7 @@ "postinstall": "./scripts/postinstall.sh" }, "name": "bs-platform", - "version": "0.5.0", + "version": "0.5.1", "description": "bucklescript compiler, ocaml standard libary by bucklescript and its required runtime support", "repository": { "type": "git",